From 1088b3244e9dd89404e6eea457727805b2fb2d89 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Thu, 12 Sep 2024 18:53:44 +0200
Subject: Port Postgres egg to CHICKEN 6

This has quite a few changes due to the low-level nature of this code:
when the contents of a string get copied by C functions, we can't pass
it to arguments of the scheme-pointer type directly anymore.

Instead, strings are now wrapper objects which point to an internal
(NUL-terminated!) bytevector.  So not only do we have to extract this
bytevector and pass it to these C functions, but we also need to
calculate the string length excluding the NUL terminator.  This
creates a bit more branching in the code to get the thing to copy and
length.

The nice thing is that we no longer need to append NUL bytes to
strings in a few places.  Instead, we can just pass the raw bytevector
to the C functions, which means this should be rather faster now.
---
 tests/run.scm | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

(limited to 'tests/run.scm')

diff --git a/tests/run.scm b/tests/run.scm
index ff4c0d2..df84a03 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -1,4 +1,4 @@
-(import (chicken blob)
+(import (scheme base)
         (chicken condition)
         (chicken string)
         test
@@ -23,7 +23,7 @@
      (test-error* (sprintf "~S" '?expr) ?error-type ?expr))))
 
 ;; Perform a quick sanity check before running the actual tests
-(condition-case (disconnect (connect '((dbname . test))))
+(condition-case (disconnect (connect '((dbname . test)) '() '()))
   (exn (exn postgresql connect)
        (print "Could not connect to server.  Please ensure that the UNIX "
               "user running these tests is allowed to connect to a database "
@@ -182,7 +182,7 @@
   ;; We are using two levels of escaping here because the ::bytea cast
   ;; performs another string interpretation. Yes, this is kinda confusing...
   (test "Result value for null-terminated byte array"
-        (blob->u8vector (string->blob "h\x00ello"))
+        #u8("h" 0 "ello")
         (value-at (query conn "SELECT E'h\\\\000ello'::bytea")))
   
   (test "Result value for raw null-terminated byte array"
@@ -191,16 +191,16 @@
             "h\\000ello")
         (value-at (query conn "SELECT E'h\\\\000ello'::bytea") 0 0 raw: #t))
 
-  (test "Result value blob for binary string"
-        (string->blob "hello")
+  (test "Result value bytevector/u8vector for binary string"
+        #u8("hello")
         (value-at (query* conn "SELECT 'hello'" '() format: 'binary)))
   
-  (test "Result value blob for binary integer"
-        (u8vector->blob (u8vector 0 0 0 1))
+  (test "Result value bytevector/u8vector for binary integer"
+        (u8vector 0 0 0 1)
         (value-at (query* conn "SELECT 1::int4" '() format: 'binary)))
 
   (test "Result value for binary string with NUL bytes"
-        (string->blob "h\x00ello")
+        #u8("h" 0 "ello")
         (value-at (query* conn "SELECT E'h\\\\000ello'::bytea" '() format: 'binary)))
 
   (test "Result value for array of integers"
@@ -298,9 +298,9 @@
   (test-assert "NULL parameters"
                (sql-null? (value-at
                            (query conn "SELECT $1::text" (sql-null)) 0 0)))
-  (test "blob parameters"
+  (test "bytevector/u8vector parameters"
         "hi"
-        (value-at (query conn "SELECT $1::text" (string->blob "hi")) 0 0))
+        (value-at (query conn "SELECT $1::text" (string->utf8 "hi")) 0 0))
   (test "boolean parameters"
         '(#t #f)
         (row-values (query conn "SELECT $1::bool, $2::bool" #t #f)))
@@ -385,9 +385,9 @@
           (if (>= major-version 9)
               "\\\\x576800617427730a75703f"
               "Wh\\\\000at''s\\\\012up?")
-          (escape-bytea conn (blob->u8vector (string->blob "Wh\x00at's\nup?"))))
-    (test "Bytea is unescaped correctly (blob)"
-          (blob->u8vector (string->blob "What's\nup? "))
+          (escape-bytea conn #u8("Wh" 0 "at's\nup?")))
+    (test "Bytea is unescaped correctly (bytevector)"
+          (string->utf8 "What's\nup? ")
           ;; The extra quote is dropped here because it wouldn't be returned
           ;; by pgsql either.
           (unescape-bytea "What's\\012up?\\ "))
@@ -405,9 +405,9 @@
           (if (>= major-version 9)
               "\\x576800617427730a75703f"
               "Wh\\000at''s\\012up?")
-          (escape-bytea conn "Wh\x00at's\nup?"))
+          (escape-bytea conn "Wh\x00;at's\nup?"))
     (test "Bytea is unescaped correctly"
-          (blob->u8vector (string->blob "What's\nup? "))
+          (string->utf8 "What's\nup? ")
           ;; The extra quote is dropped here because it wouldn't be returned
           ;; by pgsql either.
           (unescape-bytea "What's\\012up?\\ "))
@@ -645,7 +645,7 @@
         #f
         (bool-parser "f"))
   (test "Byte array parsed correctly"
-        (blob->u8vector/shared (string->blob "abc\x01\x02\xffdef"))
+        #u8("abc" #x01 #x02 #xff "def")
         (bytea-parser "abc\\001\\002\\377def"))
   (test "Char parser"
         #\x
-- 
cgit v1.2.3