gdbm: better exception handling

diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor
index 9776cdd0def32d89753383d515595e23dd969463..142e2ae2f738c08d2dbd63f0995a6ab05a666e86 100644 (file)
--- a/extra/gdbm/ffi/ffi.factor
+++ b/extra/gdbm/ffi/ffi.factor
@@ -50,28 +50,6 @@ FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ;
 FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ;
 FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ;
 
-CONSTANT: GDBM_NO_ERROR               0
-CONSTANT: GDBM_MALLOC_ERROR           1
-CONSTANT: GDBM_BLOCK_SIZE_ERROR       2
-CONSTANT: GDBM_FILE_OPEN_ERROR        3
-CONSTANT: GDBM_FILE_WRITE_ERROR       4
-CONSTANT: GDBM_FILE_SEEK_ERROR        5
-CONSTANT: GDBM_FILE_READ_ERROR        6
-CONSTANT: GDBM_BAD_MAGIC_NUMBER       7
-CONSTANT: GDBM_EMPTY_DATABASE         8
-CONSTANT: GDBM_CANT_BE_READER         9
-CONSTANT: GDBM_CANT_BE_WRITER         10
-CONSTANT: GDBM_READER_CANT_DELETE     11
-CONSTANT: GDBM_READER_CANT_STORE      12
-CONSTANT: GDBM_READER_CANT_REORGANIZE 13
-CONSTANT: GDBM_UNKNOWN_UPDATE         14
-CONSTANT: GDBM_ITEM_NOT_FOUND         15
-CONSTANT: GDBM_REORGANIZE_FAILED      16
-CONSTANT: GDBM_CANNOT_REPLACE         17
-CONSTANT: GDBM_ILLEGAL_DATA           18
-CONSTANT: GDBM_OPT_ALREADY_SET        19
-CONSTANT: GDBM_OPT_ILLEGAL            20
-
 TYPEDEF: int gdbm_error
 C-GLOBAL: gdbm_error gdbm_errno
 

diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor
index 642d0d3aeb5ed4b82ac0d8e240203a24e9e4e487..28aa9b35f28d142aed21efba540ffff3935f2530 100644 (file)
--- a/extra/gdbm/gdbm.factor
+++ b/extra/gdbm/gdbm.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2010 Dmitry Shubin.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data alien.destructors
-classes.struct combinators destructors gdbm.ffi io.backend kernel libc
-literals math namespaces sequences serialize strings ;
+USING: accessors alien.c-types alien.data alien.destructors assocs
+biassocs classes.struct combinators destructors gdbm.ffi io.backend
+kernel libc literals math namespaces sequences serialize strings ;
 IN: gdbm
 
 TUPLE: gdbm
@@ -11,15 +11,59 @@ TUPLE: gdbm
     { flags      integer initial: $ GDBM_WRCREAT }
     { mode       integer initial: OCT: 644 } ;
 
-ERROR: gdbm-error errno msg ;
+SINGLETONS:
+    gdbm-no-error             gdbm-malloc-error
+    gdbm-block-size-error     gdbm-file-open-error
+    gdbm-file-write-error     gdbm-file-seek-error
+    gdbm-file-read-error      gdbm-bad-magic-number
+    gdbm-empty-database       gdbm-cant-be-reader
+    gdbm-cant-be-writer       gdbm-reader-cant-delete
+    gdbm-reader-cant-store    gdbm-reader-cant-reorganize
+    gdbm-unknown-update       gdbm-item-not-found
+    gdbm-reorganize-failed    gdbm-cannot-replace
+    gdbm-illegal-data         gdbm-option-already-set
+    gdbm-illegal-option ;
+
+ERROR: gdbm-unknown-error error ;
 
 
 <PRIVATE
 
-: gdbm-throw ( -- * ) gdbm_errno dup gdbm_strerror gdbm-error ;
+: error-table ( -- table )
+    {
+        {  0 gdbm-no-error               }
+        {  1 gdbm-malloc-error           }
+        {  2 gdbm-block-size-error       }
+        {  3 gdbm-file-open-error        }
+        {  4 gdbm-file-write-error       }
+        {  5 gdbm-file-seek-error        }
+        {  6 gdbm-file-read-error        }
+        {  7 gdbm-bad-magic-number       }
+        {  8 gdbm-empty-database         }
+        {  9 gdbm-cant-be-reader         }
+        { 10 gdbm-cant-be-writer         }
+        { 11 gdbm-reader-cant-delete     }
+        { 12 gdbm-reader-cant-store      }
+        { 13 gdbm-reader-cant-reorganize }
+        { 14 gdbm-unknown-update         }
+        { 15 gdbm-item-not-found         }
+        { 16 gdbm-reorganize-failed      }
+        { 17 gdbm-cannot-replace         }
+        { 18 gdbm-illegal-data           }
+        { 19 gdbm-option-already-set     }
+        { 20 gdbm-illegal-option         }
+    } >biassoc ;
+
+: error>code ( error -- code )
+    dup error-table value-at [ ] [ gdbm-unknown-error ] ?if ;
+
+: code>error ( code -- error ) error-table at ;
+
+: gdbm-throw ( -- * ) gdbm_errno code>error throw ;
 
 : check-error ( ret -- ) 0 = [ gdbm-throw ] unless ;
 
+
 SYMBOL: current-dbf
 
 : dbf ( -- dbf ) current-dbf get ;
@@ -49,6 +93,8 @@ DESTRUCTOR: gdbm-close
 PRIVATE>
 
 
+: gdbm-error-message ( error -- msg ) error>code gdbm_strerror ;
+
 : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ;
 : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ;