From 510be37638edb06c40302edd3ac085349c28aece Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Fri, 24 Sep 2004 14:40:45 +0000
Subject: [PATCH] fix bdb-truncate

---
 c/bdb.c        | 16 +++++++++-------
 scheme/bdb.scm | 11 ++++++++---
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/c/bdb.c b/c/bdb.c
index 53ae3c1..082b923 100644
--- a/c/bdb.c
+++ b/c/bdb.c
@@ -394,7 +394,7 @@ s48_value scsh_bdb_env_open(s48_value env_handle, s48_value sdb_home,
   S48_DECLARE_GC_PROTECT(4);
   S48_GC_PROTECT_4(env_handle, sdb_home, sflags, smode);
   
-  dbhome = s48_extract_string(sdb_home);
+  dbhome = S48_FALSE ? NULL : s48_extract_string(sdb_home);
   dbenv = scsh_extract_dbenv(env_handle);
   mode = s48_extract_integer(smode);
   flags = s48_extract_integer(sflags);
@@ -458,7 +458,7 @@ s48_value scsh_bdb_env_set_encrypt(s48_value senv_handle, s48_value spasswd,
   memset(passwd, 0, S48_STRING_LENGTH(spasswd));
   S48_GC_UNPROTECT();
   CHECK_BDB_RESULT_CODE(res);
-  return S48_TRUE;
+  return S48_FALSE;
 }
 
 s48_value scsh_bdb_env_get_encrypt_flags(s48_value senv_handle)
@@ -760,19 +760,21 @@ s48_value scsh_bdb_truncate(s48_value db, s48_value stxnid, s48_value sflags)
   int res;
   DB *dbp;
   u_int32_t flags;
-  u_int32_t *countp;
+  u_int32_t countp;
   DB_TXN *txnid;
   
   S48_DECLARE_GC_PROTECT(3);
   S48_GC_PROTECT_3(db, stxnid, sflags);
-  dbp= scsh_extract_db(db);
+  dbp = scsh_extract_db(db);
   txnid = EXTRACT_OPTIONAL_TXNID(stxnid);
   flags = s48_extract_integer(sflags);
   S48_GC_UNPROTECT();
 	 
-  res = dbp->truncate(dbp, txnid, countp, flags);
-  CHECK_BDB_RESULT_CODE(res);
-  return S48_FALSE;
+  res = dbp->truncate(dbp, txnid, &countp, flags);
+  if (res > 0)
+    s48_raise_os_error(res);
+  return s48_list_2(s48_enter_integer(res),
+		    (res == 0) ? s48_enter_integer(countp) : S48_FALSE);
 }
 
 s48_value scsh_bdb_sync(s48_value db)
diff --git a/scheme/bdb.scm b/scheme/bdb.scm
index 89b8e02..210338e 100644
--- a/scheme/bdb.scm
+++ b/scheme/bdb.scm
@@ -834,9 +834,14 @@
   (let-optionals args
       ((txn-id (or (current-transaction-id) #f))
        (flags (or (current-flags) '())))
-    (cond 
-     ((bdb-truncate-int db-handle txn-id (flags->value flags))
-      => raise-bdb-condition))))
+    (call-with-values
+     (lambda ()
+       (apply values 
+	      (bdb-truncate-int db-handle txn-id (flags->value flags))))
+     (lambda (error-code count)
+       (if (zero? error-code)
+	   count
+	   raise-bdb-condition)))))
 
 (define (database-truncate/fork . args)
   (wait (fork