Support binding native boolean false on 5.36 and newer

.perlcriticrc

@@ -3,7 +3,7 @@ profile-strictness = quiet
 exclude = Mardem
 
 [Documentation::PodSpelling]
-stop_words = ActiveKids afterwards arrayref arrayrefs attr autocommit AutoCommit AutoInactiveDestroy backend bitmask bool boolean Bunce bytea CachedKids cancelled ChildHandles ChopBlanks CompatMode CursorName datatype Datatype datatypes dbd DBD dbdpg dbh DBI deallocation deallocated dev dr DSN enum ErrCount errstr fd FetchHashKeyName filename func getfd getline github HandleError HandleSetErr hashref hashrefs InactiveDestroy JSON largeobject len libpq LongReadLen LongTruncOk lseg Mergl Momjian Mullane nullable NULLABLE Oid OID onwards param ParamTypes ParamValues perl Perlish PgBouncer pgbuiltin pgend pglibpq pglogin pgprefix pgquote PGSERVICE PGSERVICEFILE pgsql pgstart PGSYSCONFDIR PID Postgres PostgreSQL PQexecParams PQexecPrepared PrintError PrintWarn pseudotype RaiseError README ReadOnly RowCache RowCacheSize RowsInCache runtime Sabino savepoint savepoints Savepoints schemas ShowErrorStatement SQL SQLSTATE SSL sslmode STDERR STDIN STDOUT subdirectory tablename tablespace tablespaces TaintIn TaintOut TraceLevel tuple typename undef username Username UTF varchar
+stop_words = ActiveKids afterwards arrayref arrayrefs attr autocommit AutoCommit AutoInactiveDestroy backend bitmask bool boolean Bunce bytea CachedKids cancelled ChildHandles ChopBlanks CompatMode CursorName datatype Datatype datatypes dbd DBD dbdpg dbh DBI deallocation deallocated dev dr DSN enum ErrCount errstr fd FetchHashKeyName filename func getfd getline github HandleError HandleSetErr hashref hashrefs InactiveDestroy JSON largeobject len libpq LongReadLen LongTruncOk lseg Mergl Momjian Mullane nullable NULLABLE Oid OID onwards param ParamTypes ParamValues perl Perlish PgBouncer pgbuiltin pgend pglibpq pglogin pgprefix pgquote PGSERVICE PGSERVICEFILE pgsql pgstart PGSYSCONFDIR PID Postgres PostgreSQL PQexecParams PQexecPrepared PrintError PrintWarn pseudotype RaiseError README ReadOnly RowCache RowCacheSize RowsInCache runtime Sabino savepoint savepoints Savepoints schemas ShowErrorStatement SQL SQLSTATE SSL sslmode STDERR STDIN STDOUT stringify subdirectory tablename tablespace tablespaces TaintIn TaintOut TraceLevel tuple typename undef username Username UTF varchar
 
 [-Bangs::ProhibitBitwiseOperators]
 [-Bangs::ProhibitCommentedOutCode]

Changes

@@ -2,6 +2,12 @@ Changes for the DBD::Pg module
 
 RT refers to rt.cpan.org
 
+ - Support binding native boolean false on Perl 5.36 and newer
+   [Dagfinn Ilmari Mannsåker]
+
+ - Respect pg_bool_tf when binding native booleans on Perl 5.36 and newer
+   [Dagfinn Ilmari Mannsåker]
+
 Version 3.18.0 (released December 6, 2023)
 
  - Support new PQclosePrepared function, added in Postgres 17

Pg.pm

@@ -3234,7 +3234,9 @@ should the query fail (see C<ShowErrorStatement>).
 =head3 B<pg_bool_tf> (boolean)
 
 DBD::Pg specific attribute. If true, boolean values will be returned
-as the characters 't' and 'f' instead of '1' and '0'.
+as the characters 't' and 'f' instead of '1' and '0'.  On Perl 5.36
+and newer, distinguished boolean values (see L<builtin/is_bool>) will
+also be sent as 't' and 'f' when used as placeholder values.
 
 =head3 B<ReadOnly> (boolean)
 
@@ -4455,6 +4457,16 @@ set the L<pg_bool_tf|/pg_bool_tf (boolean)> attribute to a true value to change
 Boolean values can be passed to PostgreSQL as TRUE, 't', 'true', 'y', 'yes' or
 '1' for true and FALSE, 'f', 'false', 'n', 'no' or '0' for false.
 
+On Perl 5.36 and newer, distinguished boolean values (see
+L<builtin/is_bool>) can be used as placeholder values.  They will be
+sent as C<1> and C<0>, or C<t> and C<f> if C<pg_bool_tf> is set to a
+true value.
+
+On older versions of Perl, false values returned by built-in operators
+(such as C<!!0>) must be converted to one of the above false values,
+or bound with C<< pg_type => PG_BOOL >>, since they stringify to the
+empty string.
+
 =head2 Schema support
 
 The PostgreSQL schema concept may differ from those of other databases. In a nutshell,

dbdimp.c

@@ -17,6 +17,10 @@
 #define atoll(X) _atoi64(X)
 #endif
 
+#ifndef SvIsBOOL
+#define SvIsBOOL(sv) DBDPG_FALSE
+#endif
+
 #define DEBUG_LAST_RESULT 0
 
 #if PGLIBVERSION < 80300
@@ -2625,9 +2629,18 @@ int dbd_bind_ph (SV * sth, imp_sth_t * imp_sth, SV * ph_name, SV * newvalue, IV
     (void)SvUPGRADE(newvalue, SVt_PV);
 
     if (SvOK(newvalue)) {
-        /* get the right encoding, without modifying the caller's copy */
-        newvalue = pg_rightgraded_sv(aTHX_ newvalue, imp_dbh->pg_utf8_flag && PG_BYTEA!=currph->bind_type->type_id);
-        value_string = SvPV(newvalue, currph->valuelen);
+        if (SvIsBOOL(newvalue)) {
+            /* bind native booleans as 1/0 or t/f if pg_bool_tf is set */
+            value_string = SvTRUE(newvalue)
+                ? imp_dbh->pg_bool_tf ? "t" : "1"
+                : imp_dbh->pg_bool_tf ? "f" : "0";
+            currph->valuelen = 1;
+        }
+        else {
+            /* get the right encoding, without modifying the caller's copy */
+            newvalue = pg_rightgraded_sv(aTHX_ newvalue, imp_dbh->pg_utf8_flag && PG_BYTEA!=currph->bind_type->type_id);
+            value_string = SvPV(newvalue, currph->valuelen);
+        }
         Renew(currph->value, currph->valuelen+1, char); /* freed in dbd_st_destroy */
         Copy(value_string, currph->value, currph->valuelen+1, char);
         currph->value[currph->valuelen] = '\0';

t/12placeholders.t

@@ -17,7 +17,7 @@ my $dbh = connect_database();
 if (! $dbh) {
     plan skip_all => 'Connection to database failed, cannot continue testing';
 }
-plan tests => 261;
+plan tests => 266;
 
 my $t='Connect to database for placeholder testing';
 isnt ($dbh, undef, $t);
@@ -819,6 +819,7 @@ undef         => 'NULL',
 '0e0'         => 'TRUE',
 '0 but true'  => 'TRUE',
 '0 BUT TRUE'  => 'TRUE',
+'real true'   => 'TRUE',
 'f'           => 'FALSE',
 'F'           => 'FALSE',
 0             => 'FALSE',
@@ -827,6 +828,7 @@ undef         => 'NULL',
 'false'       => 'FALSE',
 'FALSE'       => 'FALSE',
 ''            => 'FALSE',
+'real false'  => 'FALSE',
 12            => 'ERROR',
 '01'          => 'ERROR',
 '00'          => 'ERROR',
@@ -839,10 +841,12 @@ undef         => 'NULL',
 );
 
 while (my ($name,$res) = each %booltest) {
-    $name = undef if $name eq 'undef';
-    $t = sprintf 'Boolean quoting of %s',
-        defined $name ? qq{"$name"} : 'undef';
-    eval { $result = $dbh->quote($name, {pg_type => PG_BOOL}); };
+    my ($bool, $desc) =
+        $name eq 'undef'  ? (undef, $name) :
+        $name =~ /\Areal/ ? (!!($name =~ / true\z/), $name) :
+                            ($name, qq{"$name"});
+    $t = "Boolean quoting of $desc",
+    eval { $result = $dbh->quote($bool, {pg_type => PG_BOOL}); };
     if ($@) {
         if ($res eq 'ERROR' and $@ =~ /Invalid boolean/) {
             pass ($t);
@@ -887,6 +891,23 @@ $sth->bind_param(2,'TRUE',SQL_BOOLEAN);
 $sth->execute(104,'','Boolean empty string attempt number four');
 $dbh->{pg_bool_tf} = 1;
 is_deeply ($sth->fetch, [104,'f'], $t);
+$dbh->{pg_bool_tf} = 0;
+
+SKIP: {
+    skip 'Cannot test native false without builtin::is_bool', 3 unless defined &builtin::is_bool;
+    $t = q{Inserting into a boolean column with native false works};
+    $sth = $dbh->prepare($SQL);
+    $sth->execute(105, !!0, 'Boolean native false');
+    is_deeply ($sth->fetch, [105, 0], $t);
+
+    local $dbh->{pg_bool_tf} = 1;
+    $t = q{Inserting into a boolean column with native false works (pg_bool_tf on)};
+    $sth = $dbh->prepare($SQL);
+    $sth->execute(106, !!1, 'Boolean native true (pg_bool_tf on)');
+    is_deeply ($sth->fetch, [106, 't'], $t);
+    $sth->execute(107, !!0, 'Boolean native false (pg_bool_tf on)');
+    is_deeply ($sth->fetch, [107, 'f'], $t);
+}
 
 ## Test of placeholder escaping. Enabled by default, so let's jump right in
 $t = q{Basic placeholder escaping works via backslash-question mark for \?};