Fix fromListWithDef divergence

src/Data/Chimera/Internal.hs

@@ -553,13 +553,21 @@
       [] -> G.singleton a : map (\k -> G.replicate (1 `shiftL` k) a) [0 .. bits - 1]
       x : xs -> G.singleton x : go 0 xs
 
-    go k xs = case measureOff kk xs of
-      Left l ->
-        G.fromListN kk (xs ++ replicate l a)
-          : map (\n -> G.replicate (1 `shiftL` n) a) [k + 1 .. bits - 1]
-      Right (ys, zs) -> G.fromListN kk ys : go (k + 1) zs
+    go k xs =
+      if k == bits
+        then []
+        else v : go (k + 1) zs
       where
         kk = 1 `shiftL` k
+        (v, zs) =
+          case measureOff kk xs of
+            Left l ->
+              ( if l == kk
+                  then G.replicate kk a
+                  else G.fromListN kk (xs ++ replicate l a)
+              , []
+              )
+            Right (ys, zs') -> (G.fromListN kk ys, zs')
 
 -- | Create a stream of values from a given infinite list.
 --
@@ -614,7 +622,7 @@
   => v a
   -> Chimera v a
   -> Chimera v a
 prependVector (G.uncons -> Nothing) ch = ch
 prependVector (G.uncons -> Just (pref0, pref)) (Chimera as) =
   Chimera $
     fromListN (bits + 1) $

test/Test.hs

@@ -154,11 +154,20 @@ chimeraTests = testGroup "Chimera"
   , QC.testProperty "toList" $
     \x xs -> xs === take (length xs) (Ch.toList (Ch.fromListWithDef x xs :: UChimera Bool))
 
-  , QC.testProperty "fromListWithDef" $
-    \x xs ix ->
-      let jx = ix `mod` 65536 in
-        (if fromIntegral jx < length xs then xs !! fromIntegral jx else x) ===
-          Ch.index (Ch.fromListWithDef x xs :: UChimera Bool) jx
+  , testGroup "fromListWithDef"
+    [ QC.testProperty "finite list" $
+      \x xs ix ->
+        let jx = ix `mod` 65536 in
+          (if fromIntegral jx < length xs then xs !! fromIntegral jx else x) ===
+            Ch.index (Ch.fromListWithDef x xs :: UChimera Bool) jx
+
+    , QC.testProperty "infinite list" $
+      \x xs ix ->
+        let jx = ix `mod` 65536 in
+          let xs' = QC.getInfiniteList xs in
+            (xs' !! fromIntegral jx) ===
+              Ch.index (Ch.fromListWithDef x xs' :: UChimera Bool) jx
+    ]
 
   , QC.testProperty "fromInfinite" $
     \x xs ix ->