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