diff --git a/src/Data/Chimera/Internal.hs b/src/Data/Chimera/Internal.hs
index 8b9c372..019a84c 100644
--- a/src/Data/Chimera/Internal.hs
+++ b/src/Data/Chimera/Internal.hs
@@ -553,13 +553,21 @@ fromListWithDef a = Chimera . fromListN (bits + 1) . go0
       [] -> 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.
 --
diff --git a/test/Test.hs b/test/Test.hs
index 10340e7..aa1419b 100644
--- a/test/Test.hs
+++ b/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 ->