Fix tracks runtime type check. (#4193)

savonet · Oct 26, 2024 · 63aea1b · 63aea1b
1 parent 808885c
commit 63aea1b
Show file tree

Hide file tree

Showing 3 changed files with 6 additions and 4 deletions.
diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml
@@ -20,7 +20,7 @@ let eval_check ~env:_ ~tm v =
       s#content_type_computation_allowed))
   else if Source_tracks.is_value v then (
     let s = Source_tracks.source v in
-    Typing.(s#frame_type <: tm.Term.t))
+    Typing.(s#frame_type <: Type.fresh tm.Term.t))
   else if Track.is_value v then (
     let field, source = Lang_source.to_track v in
     if not source#has_content_type then (

diff --git a/src/core/source.ml b/src/core/source.ml
@@ -215,8 +215,10 @@ class virtual operator ?(stack = []) ?clock ?(name = "src") sources =
         try
           self#content_type_computation_allowed;
           if log == source_log then self#create_log;
-          source_log#info "Source %s gets up with content type: %s." id
-            (Frame.string_of_content_type self#content_type);
+          source_log#info
+            "Source %s gets up with content type: %s and frame type: %s." id
+            (Frame.string_of_content_type self#content_type)
+            (Type.to_string self#frame_type);
           self#log#debug "Clock is %s." (Clock.id self#clock);
           self#log#important "Content type is %s."
             (Frame.string_of_content_type self#content_type);

diff --git a/src/core/types/format_type.ml b/src/core/types/format_type.ml
@@ -53,7 +53,7 @@ module FormatSpecs = struct
   let subtype _ f f' = Content_base.merge f f'
 
   let sup _ f f' =
-    Content_base.merge f f';
+    Content_base.(merge (duplicate f) (duplicate f'));
     f
 
   let to_string _ = assert false