Merge pull request #492 from Affonso-Gui/fix-hashtable-delete

Fix hash-table and package symcount

lisp/c/intern.c

@@ -45,8 +45,9 @@ register pointer symvec;
     if (++hash>=size) hash=0;}
     while (1);}
 
-static pointer extendsymvec(symvec)
+static pointer extendsymvec(symvec, count)
 pointer symvec;
+int* count;
 { register pointer newsymvec,sym;
   bpointer bp;
   register int i,newsize,size,hash;
@@ -58,10 +59,12 @@ pointer symvec;
     newsize=buddysize[bp->h.bix+1]-2;
 #endif
     newsymvec=makevector(C_VECTOR,newsize);
+    *count=0;
     for (i=0; i<newsize; i++) newsymvec->c.vec.v[i]=makeint(0); /*empty mark*/
     for (i=0; i<size; i++) {	/*rehash all symbols*/
       sym=symvec->c.vec.v[i];
       if (issymbol(sym)) {
+        ++(*count);
         hash=rehash(sym->c.sym.pname) % newsize;
         while (newsymvec->c.vec.v[hash]!=makeint(0)) {	/*find an empty slot*/
           if (++hash>=newsize) hash=0;}
@@ -74,8 +77,8 @@ pointer symvec;
 pointer export(sym,pkg)
 pointer sym,pkg;
 { register pointer symvec=pkg->c.pkg.symvector;	/*external symbol table*/
-  register int size, newsymcount;
-  int  hash;
+  register int size;
+  int hash, newsymcount;
   pointer usedby,usedbylist=pkg->c.pkg.used_by;
   pointer pnam,s;
 
@@ -93,11 +96,13 @@ pointer sym,pkg;
   while (1) {
     if (symvec->c.vec.v[hash]==sym) return(sym);
     if (isint(symvec->c.vec.v[hash])) {
+      newsymcount=intval(pkg->c.pkg.symcount);
+      if(intval(symvec->c.vec.v[hash]) == 0)  // only increase count if empty
+          newsymcount+=1;
       pointer_update(symvec->c.vec.v[hash],sym);
-      newsymcount=intval(pkg->c.pkg.symcount)+1;
+      if (newsymcount > (size / 2))
+          pointer_update(pkg->c.pkg.symvector, extendsymvec(symvec, &newsymcount));
       pkg->c.pkg.symcount=makeint(newsymcount);
-      if (newsymcount > (size / 2)) 
-          pointer_update(pkg->c.pkg.symvector, extendsymvec(symvec));
       return(sym);}
     else if (++hash>=size) hash=0;}
   }
@@ -123,17 +128,19 @@ pointer pkg;	/*destination package*/
   newsym=makesymbol(ctx,id,l,pkg);
   /*put it in the package*/
   while (issymbol(symvec->c.vec.v[hash]))  if (++hash>=size) hash=0;
+  l=intval(pkg->c.pkg.intsymcount);
+  if (intval(symvec->c.vec.v[hash]) == 0)  // only increase count if empty
+    l+=1;
   pointer_update(symvec->c.vec.v[hash],newsym);
   if (pkg==keywordpkg) {
     newsym->c.sym.vtype=V_CONSTANT;
     pointer_update(newsym->c.sym.speval,newsym);
     export(newsym,pkg);}
-  l=intval(pkg->c.pkg.intsymcount)+1;
-  pkg->c.pkg.intsymcount=makeint(l);
   if (l>(size/2)) { /*extend hash table*/
     vpush(newsym);
-    pointer_update(pkg->c.pkg.intsymvector,extendsymvec(symvec));
+    pointer_update(pkg->c.pkg.intsymvector,extendsymvec(symvec, &l));
     vpop();}
+  pkg->c.pkg.intsymcount=makeint(l);
   /* export all the symbols to avoid incompatibility with old EusLisp*/
   if (export_all) export(newsym, pkg);
 #ifdef SAFETY

lisp/l/hashtab.l

@@ -12,6 +12,7 @@
 			((key :type vector)
 			 (value :type vector)
 			 (size :type :integer)
+			 (fill-count :type :integer)
 			 (count :type :integer)
 			 (hash-function)
 			 (test-function)
@@ -45,11 +46,13 @@
  (:enter (sym val)
     (let ((entry (send self :find sym)))
       (when (>= entry size)	;new entry?
-	 (when (> count (/ size rehash-size))
+	 (when (> fill-count (/ size rehash-size))
 	     (send self :extend)
 	     (setq entry (send self :find sym))  )
+	 (setq entry (- entry size))
 	 (inc count)
-	 (setq entry (- entry size)))
+	 (if (eq (svref key entry) empty)
+	     (inc fill-count)))
       (svset key entry sym)
       (svset value entry val)
       val))
@@ -74,6 +77,7 @@
 	    x size
 	    size altsize
 	    altsize x
+	    fill-count 0
 	    count 0)
       (dotimes (i altsize)
 	 (setq x (svref altkey i))
@@ -118,6 +122,8 @@
     (dotimes (i size)
 	(setf (aref key i) empty
 	      (aref value i) nil))
+    (setq count 0)
+    (setq fill-count 0)
     self)
  (:prin1 (&optional (strm t) &rest mesgs)
     (send-super* :prin1 strm
@@ -133,6 +139,7 @@
 	  empty (gensym "EMPTY")
 	  deleted (gensym "DEL")
 	  not-found nofound
+	  fill-count 0
 	  count 0
 	  rehash-size rehash)
     (dotimes (i s) (svset key i empty))

lisp/l/packsym.l

@@ -150,8 +150,10 @@
       (if (>= intsymcount size)  (error "can not enter ~a into this package, maximum symbol size is ~a" sym size))
       (while (symbolp (svref intsymvector hash))
 	(if (>= (setq hash (1+ hash)) size) (setq hash 0)))
+      (if (= (elt intsymvector hash) 0)
+          (setq intsymcount (1+ intsymcount)))
       (svset intsymvector hash sym)
-      (setq intsymcount (1+ intsymcount))
+      ;; TODO: expand if necessary
       sym))
  (:find (s)	;find symbol just in this package
     (declare (symbol s))
@@ -179,12 +181,10 @@
 	  (setq (sym . homepkg) nil))
       (setq pos (send self :find sym))
       (when pos
-	(svset intsymvector pos 1)		;deleted mark
-	(setq intsymcount (1- intsymcount)))
+	(svset intsymvector pos 1))		;deleted mark
       (setq pos (send self :find-external sym))
       (when pos
-	(svset symvector pos 1)		;deleted mark
-	(setq symcount (1- symcount)))
+	(svset symvector pos 1))		;deleted mark
     ))
  (:find-external (s)
     (declare (symbol s))

test/hashtable.l

@@ -0,0 +1,105 @@
+(require :unittest "lib/llib/unittest.l")
+
+(init-unit-test)
+
+(deftest test-hashtable-delete ()
+  (let ((ht (make-hash-table :size 10)))
+    (dotimes (i (send ht :size))
+      (send ht :enter i t)
+      (send ht :delete i))
+    (assert (find (lisp::hash-table-empty ht) (hash-table-key ht))
+            "No empty members left in hash table")))
+
+(deftest test-hashtable-count ()
+  (flet ((check-count (ht)
+           (assert (= (hash-table-count ht)
+                      (- (hash-table-size ht)
+                         (count (lisp::hash-table-empty ht) (hash-table-key ht))
+                         (count (lisp::hash-table-deleted ht) (hash-table-key ht))))
+                   "Hash-table count value does not match!")
+           (when (find 'lisp::fill-count (send hash-table :slots))
+             (assert (= (ht . lisp::fill-count)
+                        (- (hash-table-size ht)
+                           (count (lisp::hash-table-empty ht) (hash-table-key ht))))
+                     "Hash-table count value does not match!"))))
+    (let ((ht (make-hash-table :size 10 :rehash-size 2.0)))
+      (dotimes (i 6) (send ht :enter i t))
+      (check-count ht)
+      (dotimes (i 6) (send ht :delete i))
+      (check-count ht)
+      (send ht :extend)
+      (check-count ht))))
+
+(deftest test-package-unintern ()
+  (let ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE")))))
+    (dotimes (i (length (package-intsymvector pkg)))
+      (unintern
+       (intern (format nil "A~c" (+ #\A i)) pkg)
+       pkg))
+    (assert (find 0 (package-intsymvector pkg))
+            "No empty members left in package")))
+
+(deftest test-package-unintern-export ()
+  (let ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE")))))
+    (dotimes (i (length (package-intsymvector pkg)))
+      (let ((sym (intern (format nil "A~c" (+ #\A i)) pkg)))
+        (export sym pkg)
+        (unintern sym pkg)))
+    (assert (find 0 (package-intsymvector pkg))
+            "No empty internal members left in package")
+    (assert (find 0 (package-symvector pkg))
+            "No empty external members left in package")))
+
+;; (deftest test-package-enter-unintern ()
+;;   (let ((pkg (make-package "TEST-PACKAGE")))
+;;     (dotimes (i (length (package-intsymvector pkg)))
+;;       (let ((sym (intern (format nil "~c" (+ #\A i)) *user-package*)))
+;;         (send pkg :unintern (send pkg :enter sym))))
+;;     (assert (find 0 (package-intsymvector pkg))
+;;             "No empty members left in package")))
+
+(deftest test-package-intsymcount ()
+  (flet ((check-count (pkg)
+           (assert (= (package-intsymcount pkg)
+                      (- (length (package-intsymvector pkg))
+                         (count 0 (package-intsymvector pkg))))
+                   "Package intsymcount value does not match!")))
+    (let* ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE"))))
+           (half-len (/ (length (package-intsymvector pkg)) 2)))
+    (dotimes (i half-len)
+      (intern (format nil "A~c" (+ #\A i)) pkg))
+    (check-count pkg)
+    (dotimes (i half-len)
+      (unintern (intern (format nil "A~c" (+ #\A i)) pkg) pkg))
+    (check-count pkg)
+    ;; assuming a rehash-size of 2.0
+    (intern (format nil "A~c" (+ #\A half-len)) pkg)  ;; extend
+    (check-count pkg))))
+
+(deftest test-package-symcount ()
+  (flet ((check-count (pkg)
+           (assert (= (package-intsymcount pkg)
+                      (- (length (package-intsymvector pkg))
+                         (count 0 (package-intsymvector pkg))))
+                   "Package intsymcount value does not match!")
+           (assert (= (package-symcount pkg)
+                      (- (length (package-symvector pkg))
+                         (count 0 (package-symvector pkg))))
+                   "Package symcount value does not match!")))
+    (let* ((pkg (make-package (symbol-pname (gensym "TEST-PACKAGE"))))
+           (half-len (/ (length (package-intsymvector pkg)) 2)))
+    (dotimes (i half-len)
+      (let ((sym (intern (format nil "A~c" (+ #\A i)) pkg)))
+        (export sym pkg)))
+    (check-count pkg)
+    (dotimes (i half-len)
+      (unintern (intern (format nil "A~c" (+ #\A i)) pkg) pkg))
+    (check-count pkg)
+    ;; assuming a rehash-size of 2.0
+    (intern (format nil "A~c" (+ #\A half-len)) pkg)  ;; extend
+    (check-count pkg))))
+
+
+(eval-when (load eval)
+  (run-all-tests)
+  (exit))