diff --git a/src/core/operators/dyn_op.ml b/src/core/operators/dyn_op.ml index 01c60d48ac..a290e71070 100644 --- a/src/core/operators/dyn_op.ml +++ b/src/core/operators/dyn_op.ml @@ -28,7 +28,6 @@ class dyn ~init ~track_sensitive ~infallible ~self_sync ~merge next_fn = val mutable activation = [] val current_source : Source.source option Atomic.t = Atomic.make init method current_source = Atomic.get current_source - val mutable last_select = Unix.gettimeofday () method private no_source = if infallible then @@ -48,29 +47,35 @@ class dyn ~init ~track_sensitive ~infallible ~self_sync ~merge next_fn = s#wake_up method private exchange s = - self#log#info "Switching to source %s" s#id; - self#prepare s; - Atomic.set current_source (Some s); - if s#is_ready then Some s else self#no_source + match self#current_source with + | Some s' when s == s' -> Some s + | _ -> + self#log#info "Switching to source %s" s#id; + self#prepare s; + Atomic.set current_source (Some s); + if s#is_ready then Some s else self#no_source method private get_next reselect = self#mutexify (fun () -> - last_select <- Unix.gettimeofday (); let s = Lang.apply next_fn [] |> Lang.to_option |> Option.map Lang.to_source in - match s with - | None -> ( - match self#current_source with - | Some s - when self#can_reselect - ~reselect: - (match reselect with `Force -> `Ok | v -> v) - s -> - Some s - | _ -> self#no_source) - | Some s -> self#exchange s) + match (s, self#current_source) with + | None, Some s + when self#can_reselect + ~reselect:(match reselect with `Force -> `Ok | v -> v) + s -> + Some s + | Some s, Some s' when s == s' -> + if + self#can_reselect + ~reselect:(match reselect with `Force -> `Ok | v -> v) + s + then Some s + else self#no_source + | Some s, _ -> self#exchange s + | _ -> self#no_source) () method private get_source ~reselect () = diff --git a/src/core/sources/debug_sources.ml b/src/core/sources/debug_sources.ml index db0d0594c7..a8dec07838 100644 --- a/src/core/sources/debug_sources.ml +++ b/src/core/sources/debug_sources.ml @@ -58,4 +58,28 @@ let _ = ~descr: "A source that errors during its initialization phase, used for testing \ and debugging." ~flags:[`Experimental] ~return_t [] (fun _ -> - (new fail_init :> Source.source)) + new fail_init) + +class is_ready s = + object (self) + inherit Source.operator ~name:"is_ready" [s] + method seek_source = (self :> Source.source) + method fallible = true + method private can_generate_frame = true + method self_sync = (`Static, None) + method remaining = 0 + method abort_track = () + method generate_frame = if s#is_ready then s#get_frame else self#empty_frame + end + +let _ = + let return_t = Lang.frame_t (Lang.univ_t ()) Frame.Fields.empty in + Lang.add_operator ~base:Modules.debug "is_ready" ~category:`Input + ~descr: + "A source that always produces an empty frame when the underlying source \ + is not ready, used for testing and debugging." + ~flags:[`Experimental] ~return_t + [("", Lang.source_t return_t, None, None)] + (fun p -> + let s = Lang.to_source (List.assoc "" p) in + new is_ready s) diff --git a/tests/regression/GH4159.liq b/tests/regression/GH4159.liq new file mode 100644 index 0000000000..e17b86607d --- /dev/null +++ b/tests/regression/GH4159.liq @@ -0,0 +1,5 @@ +s = debug.is_ready(sine(duration=0.2)) + +s = source.dynamic(track_sensitive=false, {s}) + +output.dummy(fallible=true, on_stop=test.pass, s) diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc index e8c347a689..25850015bc 100644 --- a/tests/regression/dune.inc +++ b/tests/regression/dune.inc @@ -735,6 +735,22 @@ (:run_test ../run_test.exe)) (action (run %{run_test} GH4144.liq liquidsoap %{test_liq} GH4144.liq))) +(rule + (alias citest) + (package liquidsoap) + (deps + GH4159.liq + ../media/all_media_files + ../../src/bin/liquidsoap.exe + ../streams/file1.png + ../streams/file1.mp3 + ./theora-test.mp4 + (package liquidsoap) + (source_tree ../../src/libs) + (:test_liq ../test.liq) + (:run_test ../run_test.exe)) + (action (run %{run_test} GH4159.liq liquidsoap %{test_liq} GH4159.liq))) + (rule (alias citest) (package liquidsoap)