aa80385450d0 — Chris Cannam 2 years ago
Fixes and tests for start padding block stream
3 files changed, 210 insertions(+), 28 deletions(-)

M blockstream-fn.sml
M duration-adapting-fn.sml
M test.sml
M blockstream-fn.sml +1 -1
@@ 410,7 410,7 @@ functor SampleStreamFromBlockStreamFn (S
         Option.map
             (fn upstream' =>
                 { position = RealTime.toFrame IEEEReal.TO_NEAREST
-                                              (S.time upstream, S.rate upstream),
+                                              (S.time upstream', S.rate upstream'),
                   upstream = upstream'
             })
             (S.seek (upstream, mode, t))

          
M duration-adapting-fn.sml +49 -27
@@ 492,6 492,19 @@ functor PaddedBlockStreamFn (S : BLOCK_S
 end
 
 (** Augment a block stream with a number of zero blocks at the start.
+
+    Besides the lack of end padding, there are two other fundamental
+    differences between this and PaddedBlockStreamFn:
+
+    * Unlike PaddedBlockStreamFn.time, which tracks the upstream time,
+      extending the start padding in a negative direction from the
+      upstream's start, StartPaddedBlockStreamFn.time instead has its
+      own timeline, taking time 0 as the start of the start padding
+      and counting up from there. This is consistent with
+      StartPaddedStatefulStreamFn.
+
+    * StartPaddedBlockStreamFn is seekable if the upstream is (see
+      notes in comments).
  *)
 functor StartPaddedBlockStreamFn (S : BLOCK_STREAM) :
         sig

          
@@ 520,11 533,14 @@ functor StartPaddedBlockStreamFn (S : BL
     fun blocksize ({ upstream, ... } : stream) = S.blocksize upstream
 
     fun time ({ padding, startTime, hop, remainingAtStart, upstream } : stream) =
-        let val t = S.time upstream
+        let val t =
+                if remainingAtStart > 0
+                then RealTime.* (hop, padding - remainingAtStart)
+                else RealTime.+ (RealTime.* (hop, padding),
+                                 RealTime.- (S.time upstream, startTime))
+            val () = debug (fn () => ["StartPaddedBlockStreamFn.time: remainingAtStart = %1, hop = %2, padding = %3, upstream time = %4, start time = %5, returning %6", I remainingAtStart, RealTime.toString hop, I padding, RealTime.toString (S.time upstream), RealTime.toString startTime, RealTime.toString t])
         in
-            if remainingAtStart > 0
-            then RealTime.- (t, RealTime.* (hop, remainingAtStart))
-            else t
+            t
         end
 
     (* Although PaddedBlockStreamFn is not seekable,

          
@@ 573,40 589,46 @@ functor StartPaddedBlockStreamFn (S : BL
                | NONE => NONE
 
     fun seek ({ padding, startTime, hop, upstream, ... } : stream, mode, t) =
-        let val snapped = RealTime.snap (RealTime.- (t, startTime), hop)
+        let val padTime = RealTime.* (hop, padding)
+            val snapped = RealTime.snap (t, hop)
+            val () = debug (fn () => ["StartPaddedBlockStreamFn.seek: snapped time %1 to %2 with hop %3, pad time %4, and start time %5", RealTime.toString t, RealTime.toString snapped, RealTime.toString hop, RealTime.toString padTime, RealTime.toString startTime])
         in
-            if RealTime.< (snapped, RealTime.zeroTime)
-            then let val hops = ~ (RealTime.chunk (snapped, hop))
-                 in
-                     if hops > padding
-                     then NONE
-                     else SOME { padding = padding,
-                                 startTime = startTime,
-                                 hop = hop,
-                                 remainingAtStart = hops,
-                                 upstream = upstream
-                               }
+            if RealTime.< (snapped, padTime)
+            then case S.seek (upstream, mode, startTime) of
+                     NONE => NONE
+                   | SOME upstream' => 
+                     SOME { padding = padding,
+                            startTime = startTime,
+                            hop = hop,
+                            remainingAtStart = padding -
+                                               RealTime.chunk (snapped, hop),
+                            upstream = upstream'
+                          }
+            else let val target = RealTime.+ (startTime,
+                                              RealTime.- (snapped, padTime))
+                 in case S.seek (upstream, mode, target) of
+                        NONE => NONE
+                      | SOME upstream' => 
+                        (debug (fn () => ["StartPaddedBlockStreamFn.seek: upstream seek to %1 succeeded, upstream now at time %2", RealTime.toString target, RealTime.toString (S.time upstream')]);
+                         SOME { padding = padding,
+                                startTime = startTime,
+                                hop = hop,
+                                remainingAtStart = 0,
+                                upstream = upstream'
+                        })
                  end
-            else case S.seek (upstream, mode, snapped) of
-                     NONE => NONE
-                   | SOME upstream' => SOME { padding = padding,
-                                              startTime = startTime,
-                                              hop = hop,
-                                              remainingAtStart = 0,
-                                              upstream = upstream'
-                                            }
         end
                      
     fun foldl f = BlockStreamFolder.makeFoldl (read, f)
 
     fun wrap ({ padding : int }, upstream) =
-        let open SampleStreamLog
-            val () = debug (fn () => ["StartPaddedBlockStreamFn.wrap: padding = %1", Log.I padding])
+        let val startTime = S.time upstream
             val blockRate = Helper.deduceBlockRate upstream
             val hop = RealTime.fromFrame (SignalTypes.FRAME 1, blockRate)
+            val () = debug (fn () => ["StartPaddedBlockStreamFn.wrap: padding = %1, startTime = %2, blockRate = %3, hop = %4 (equivalent to %5 upstream frames)", Log.I padding, RealTime.toString startTime, R (SignalTypes.rateOf blockRate), RealTime.toString hop, I (SignalTypes.frameOf (RealTime.toFrame IEEEReal.TO_NEAREST (hop, S.rate upstream)))])
         in
             { padding = padding,
-              startTime = S.time upstream,
+              startTime = startTime,
               hop = hop,
               remainingAtStart = padding,
               upstream = upstream

          
M test.sml +160 -0
@@ 106,6 106,14 @@ structure TestPadded : TESTS = struct
                       (StatefulSampleStreamFromStatelessFn
                            (StatelessSyntheticStream))
 
+    (* Adapting this block stream to a sample stream makes it simpler
+       to cheesily adapt the tests for P *)
+    structure B = StatefulSampleStreamFromStatelessFn
+                      (SampleStreamFromBlockStreamFn
+                           (StartPaddedBlockStreamFn
+                                (BlockStreamFromStatelessFn
+                                     (StatelessSyntheticStream))))
+                      
     structure RM = RealMatrix
     structure RT = RealTime
 

          
@@ 128,6 136,21 @@ structure TestPadded : TESTS = struct
             end
         end
 
+    fun checkReadMonoB s expected =
+        let val t = B.time s
+            val v = RealVector.fromList expected
+            val n = RealVector.length v
+            val mopt = B.read (s, n)
+        in
+            checkSome mopt andalso
+            let val m = Option.valOf mopt in
+                intsEqual (RM.rows m, 1) andalso
+                realVectorsEqual (RM.row (m, 0), v) andalso
+                realTimesEqual (B.time s, RT.+ (t, RT.fromFrame
+                                                         (FRAME n, B.rate s)))
+            end
+        end
+
     val mode = SampleStreamTypes.SEEK_COMPLETE
             
     fun tests () = [

          
@@ 145,6 168,22 @@ structure TestPadded : TESTS = struct
                 checkReadMono p [ 0.0, 1.0, 2.0, 3.0 ]
             end
         ),
+        ("no-padding-b",
+         fn () =>
+            let val p = B.new ({ padding = 0 },
+                               ({ blocksize = 10 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                               )
+                              )
+            in
+                equal (rateOf (B.rate p), 80.0) andalso
+                realTimesEqual (B.time p, RT.zeroTime) andalso
+                checkReadMonoB p [ 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
         ("no-padding-seek",
          fn () =>
             let val p = P.new ({ padding = 0 },

          
@@ 160,11 199,36 @@ structure TestPadded : TESTS = struct
                    | _ => false) andalso
                 realTimesEqual (P.time p, RT.zeroTime) andalso
                 verify (P.seek (p, mode, RT.fromFrame (FRAME 5, P.rate p))) andalso
+                realTimesEqual (P.time p, RT.fromFrame (FRAME 5, P.rate p))andalso
                 checkReadMono p [ 5.0, 6.0, 7.0, 8.0 ] andalso
                 verify (P.seek (p, mode, RT.fromFrame (FRAME 1, P.rate p))) andalso
                 checkReadMono p [ 1.0, 2.0, 3.0, 4.0 ]
             end
         ),
+        ("no-padding-seek-b",
+         fn () =>
+            let val b = B.new ({ padding = 0 },
+                               ({ blocksize = 2 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                (case B.seekable b of
+                     SampleStreamTypes.SEEKABLE { startTime, endTime = NONE } =>
+                     true
+                   | _ => false) andalso
+                (* This one seeks to block boundaries *)
+                realTimesEqual (B.time b, RT.zeroTime) andalso
+                verify (B.seek (b, mode, RT.fromFrame (FRAME 5, B.rate b))) andalso
+                realTimesEqual (B.time b, RT.fromFrame (FRAME 4, B.rate b)) andalso
+                checkReadMonoB b [ 4.0, 5.0, 6.0, 7.0 ] andalso
+                verify (B.seek (b, mode, RT.fromFrame (FRAME 1, B.rate b))) andalso
+                realTimesEqual (B.time b, RT.zeroTime) andalso
+                checkReadMonoB b [ 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
         ("padding",
          fn () =>
             let val p = P.new ({ padding = 4 },

          
@@ 179,6 243,36 @@ structure TestPadded : TESTS = struct
                 checkReadMono p [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ]
             end
         ),
+        ("padding-b4",
+         fn () =>
+            let val b = B.new ({ padding = 1 },
+                               ({ blocksize = 4 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                equal (rateOf (B.rate b), 80.0) andalso
+                realTimesEqual (B.time b, RT.zeroTime) andalso
+                checkReadMonoB b [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
+        ("padding-b2",
+         fn () =>
+            let val b = B.new ({ padding = 2 },
+                               ({ blocksize = 2 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                equal (rateOf (B.rate b), 80.0) andalso
+                realTimesEqual (B.time b, RT.zeroTime) andalso
+                checkReadMonoB b [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
         ("padding-seek", (* Seeking to beyond cutover before reading at all *)
          fn () =>
             let val p = P.new ({ padding = 4 },

          
@@ 201,6 295,33 @@ structure TestPadded : TESTS = struct
                 checkReadMono p [ 0.0, 1.0, 2.0, 3.0 ]
             end
         ),
+        ("padding-seek-b", (* Seeking to beyond cutover before reading at all *)
+         fn () =>
+            let val p = B.new ({ padding = 2 },
+                               ({ blocksize = 2 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                (case B.seekable p of
+                     SampleStreamTypes.SEEKABLE { startTime, endTime = NONE } =>
+                     true
+                   | _ => false) andalso
+                (* This one seeks to block boundaries *)
+                realTimesEqual (B.time p, RT.zeroTime) andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 8, B.rate p))) andalso
+                realTimesEqual (B.time p, RT.fromFrame (FRAME 8, B.rate p)) andalso
+                checkReadMonoB p [ 4.0, 5.0, 6.0, 7.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 1, B.rate p))) andalso
+                realTimesEqual (B.time p, RealTime.zeroTime) andalso
+                checkReadMonoB p [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 5, B.rate p))) andalso
+                realTimesEqual (B.time p, RT.fromFrame (FRAME 4, B.rate p)) andalso
+                checkReadMonoB p [ 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
         ("padding-seek-2", (* Reading to precisely cutover before seeking at all *)
          fn () =>
             let val p = P.new ({ padding = 4 },

          
@@ 219,6 340,26 @@ structure TestPadded : TESTS = struct
                 checkReadMono p [ 0.0, 1.0, 2.0, 3.0 ]
             end
         ),
+        ("padding-seek-2-b", (* Reading to precisely cutover before seeking at all *)
+         fn () =>
+            let val p = B.new ({ padding = 1 },
+                               ({ blocksize = 4 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                (* This one seeks to block boundaries *)
+                checkReadMonoB p [ 0.0, 0.0, 0.0, 0.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 9, B.rate p))) andalso
+                realTimesEqual (B.time p, RT.fromFrame (FRAME 8, B.rate p)) andalso
+                checkReadMonoB p [ 4.0, 5.0, 6.0, 7.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 1, B.rate p))) andalso
+                realTimesEqual (B.time p, RT.zeroTime) andalso
+                checkReadMonoB p [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ]
+            end
+        ),
         ("padding-seek-3", (* Reading to beyond cutover before seeking at all *)
          fn () =>
             let val p = P.new ({ padding = 4 },

          
@@ 236,6 377,25 @@ structure TestPadded : TESTS = struct
                 verify (P.seek (p, mode, RT.fromFrame (FRAME 4, P.rate p))) andalso
                 checkReadMono p [ 0.0, 1.0, 2.0, 3.0 ]
             end
+        ),
+        ("padding-seek-3-b", (* Reading to beyond cutover before seeking at all *)
+         fn () =>
+            let val p = B.new ({ padding = 2 },
+                               ({ blocksize = 2 },
+                                { rate = RATE 80.0,
+                                  sort = StatelessSyntheticStream.GENERATED
+                                             (fn i => SOME (real i))
+                                }
+                              ))
+            in
+                (* This one seeks to block boundaries *)
+                checkReadMonoB p [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 9, B.rate p))) andalso
+                realTimesEqual (B.time p, RT.fromFrame (FRAME 8, B.rate p)) andalso
+                checkReadMonoB p [ 4.0, 5.0, 6.0, 7.0 ] andalso
+                verify (B.seek (p, mode, RT.fromFrame (FRAME 1, B.rate p))) andalso
+                checkReadMonoB p [ 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 2.0, 3.0 ]
+            end
         )
     ]