unrolled-lists: fix empty list popping (#2729)

Added documentation for the unrolled-list class,
and added new tests for the issue fix.

diff --git a/basis/unrolled-lists/unrolled-lists-docs.factor b/basis/unrolled-lists/unrolled-lists-docs.factor
index dd8611db9d2c110af71c559140e1006924579786..a9094d5caac918008bbd6b5f436fb417877b7471 100644 (file)
--- a/basis/unrolled-lists/unrolled-lists-docs.factor
+++ b/basis/unrolled-lists/unrolled-lists-docs.factor
@@ -1,9 +1,24 @@
 IN: unrolled-lists
 USING: help.markup help.syntax hashtables search-deques dlists
-deques ;
+deques unrolled-lists.private ;
 
 HELP: unrolled-list
-{ $class-description "The class of unrolled lists." } ;
+{ $class-description "The class of unrolled lists."
+    $nl
+    "All nodes in an unrolled list contain an array of 32 items. Nodes point to the previous"
+    " node and next node, or " { $link f } " if they do not exist."
+    { $slots
+        { "front" { "The front " { $link node } " of the list or " { $link f } "." } }
+        { "front-pos" { "The position of the front element of the list in " 
+          { $snippet "front" } "." } }
+        { "back" { "The back " { $link node } " of the list or " { $link f } "." } }
+        { "back-pos" { "The position of the back element of the list in " 
+          { $snippet "back" } "." } }
+    }
+    $nl
+    "It is not recommended to modify any of these slots manually. Using the "
+    { $link deque } " protocol provides safer operations."
+} ;
 
 HELP: <unrolled-list>
 { $values { "list" unrolled-list } }

diff --git a/basis/unrolled-lists/unrolled-lists-tests.factor b/basis/unrolled-lists/unrolled-lists-tests.factor
index 69c1c38cb8578c849473b35b8ef5b7e40f69f1bd..2032020cd3fc22e6c51281bc4575827925ffcb1d 100644 (file)
--- a/basis/unrolled-lists/unrolled-lists-tests.factor
+++ b/basis/unrolled-lists/unrolled-lists-tests.factor
@@ -1,5 +1,5 @@
 USING: unrolled-lists tools.test deques kernel sequences
-random prettyprint grouping math ;
+random prettyprint grouping math ranges ;
 
 { 1 } [ <unrolled-list> 1 over push-front pop-front ] unit-test
 { 1 } [ <unrolled-list> 1 over push-front pop-back ] unit-test
@@ -127,3 +127,14 @@ random prettyprint grouping math ;
     dup pop-back 30 assert=
     deque-empty?
 ] unit-test
+
+! In relation to https://github.com/factor/factor/issues/2729
+10 [| |
+    <unrolled-list> :> l
+    [
+        33 200 [a..b] random dup
+        l swap [1..b] [ over push-back ] each
+        swap [ dup pop-front drop ] times
+        dup pop-front swap pop-back
+    ] [ empty-deque? ] must-fail-with
+] times

diff --git a/basis/unrolled-lists/unrolled-lists.factor b/basis/unrolled-lists/unrolled-lists.factor
index 8a3e9ff809ef44b4ca3ca27a9fc0b326c5fdc57c..244faa888d4e43907af2662ce5c63631a84b60c2 100644 (file)
--- a/basis/unrolled-lists/unrolled-lists.factor
+++ b/basis/unrolled-lists/unrolled-lists.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2023 Slava Pestov and Raghu Ranganathan.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: arrays math kernel accessors sequences sequences.private
 deques search-deques hashtables ;
@@ -54,6 +54,9 @@ M: unrolled-list clear-deque
         dup prev>> [ drop ] [ swap front>> >>prev ] if
     ] [ dup front>> >>back ] if* drop ; inline
 
+: clear-if-empty ( list -- )
+    dup deque-empty? [ dup clear-deque ] when drop ;
+
 : push-front/new ( elt list -- )
     unroll-factor 1 - >>front-pos
     [ <front-node> ] change-front
@@ -82,7 +85,7 @@ M: unrolled-list peek-front*
 : pop-front/existing ( list front -- )
     [ dup front-pos>> ] [ data>> ] bi* [ 0 ] 2dip set-nth-unsafe
     [ 1 + ] change-front-pos
-    drop ; inline
+    clear-if-empty ; inline
 
 M: unrolled-list pop-front*
     dup front>> [ empty-unrolled-list ] unless*
@@ -128,7 +131,7 @@ M: unrolled-list peek-back*
 : pop-back/existing ( list back -- )
     [ [ 1 - ] change-back-pos ] dip
     [ dup back-pos>> ] [ data>> ] bi* [ 0 ] 2dip set-nth-unsafe
-    drop ; inline
+    clear-if-empty ; inline
 
 M: unrolled-list pop-back*
     dup back>> [ empty-unrolled-list ] unless*