Check attached attributes in decode function rather than migration

Nathan Rebours · Nathan Rebours · commit 115ec198b621 · 2026-03-06T09:49:30.000+01:00
Signed-off-by: Nathan Rebours &lt;nathan.rebours@ocamlpro.com&gt;
diff --git a/astlib/encoding_504.ml b/astlib/encoding_504.ml
@@ -434,31 +434,33 @@ module To_503 = struct
   let encode_bivariant_psig_class_type ~loc ctds =
     encode_bivariant_psig ~loc (Psig_class_type ctds)
 
-  let decode_bivariant_pstr ~loc payload =
-    match payload with
-    | PStr
-        [
-          {
-            pstr_desc =
-              (Pstr_type _ | Pstr_typext _ | Pstr_class _ | Pstr_class_type _)
-              as x;
-            _;
-          };
-        ] ->
+  let decode_bivariant_pstr ~loc payload attributes =
+    match (payload, attributes) with
+    | ( PStr
+          [
+            {
+              pstr_desc =
+                (Pstr_type _ | Pstr_typext _ | Pstr_class _ | Pstr_class_type _)
+                as x;
+              _;
+            };
+          ],
+        [] ) ->
         x
     | _ -> invalid_encoding ~loc "bivariant structure_item"
 
-  let decode_bivariant_psig ~loc payload =
-    match payload with
-    | PSig
-        [
-          {
-            psig_desc =
-              ( Psig_type _ | Psig_typesubst _ | Psig_typext _ | Psig_class _
-              | Psig_class_type _ ) as x;
-            _;
-          };
-        ] ->
+  let decode_bivariant_psig ~loc payload attributes =
+    match (payload, attributes) with
+    | ( PSig
+          [
+            {
+              psig_desc =
+                ( Psig_type _ | Psig_typesubst _ | Psig_typext _ | Psig_class _
+                | Psig_class_type _ ) as x;
+              _;
+            };
+          ],
+        [] ) ->
         x
     | _ -> invalid_encoding ~loc "bivariant signature_item"
 
diff --git a/astlib/encoding_504.mli b/astlib/encoding_504.mli
@@ -68,8 +68,12 @@ module To_503 : sig
   val encode_bivariant_pmty_with :
     loc:Location.t -> module_type -> with_constraint list -> module_type_desc
 
-  val decode_bivariant_pstr : loc:Location.t -> payload -> structure_item_desc
-  val decode_bivariant_psig : loc:Location.t -> payload -> signature_item_desc
+  val decode_bivariant_pstr :
+    loc:Location.t -> payload -> attributes -> structure_item_desc
+
+  val decode_bivariant_psig :
+    loc:Location.t -> payload -> attributes -> signature_item_desc
+
   val decode_bivariant_pmty_with : loc:Location.t -> payload -> module_type_desc
 end
 
diff --git a/astlib/migrate_503_504.ml b/astlib/migrate_503_504.ml
@@ -585,9 +585,9 @@ and copy_structure_item_desc_with_loc ~loc :
       Ast_504.Parsetree.Pstr_include (copy_include_declaration x0)
   | Ast_503.Parsetree.Pstr_attribute x0 ->
       Ast_504.Parsetree.Pstr_attribute (copy_attribute x0)
-  | Ast_503.Parsetree.Pstr_extension (({ txt; _ }, payload), [])
+  | Ast_503.Parsetree.Pstr_extension (({ txt; _ }, payload), attr)
     when String.equal txt Encoding_504.Ext_name.bivariant_pstr ->
-      let desc = Encoding_504.To_503.decode_bivariant_pstr ~loc payload in
+      let desc = Encoding_504.To_503.decode_bivariant_pstr ~loc payload attr in
       copy_structure_item_desc_with_loc ~loc desc
   | Ast_503.Parsetree.Pstr_extension (x0, x1) ->
       Ast_504.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1)
@@ -884,9 +884,9 @@ and copy_signature_item_desc_with_loc ~loc :
         (List.map copy_class_type_declaration x0)
   | Ast_503.Parsetree.Psig_attribute x0 ->
       Ast_504.Parsetree.Psig_attribute (copy_attribute x0)
-  | Ast_503.Parsetree.Psig_extension (({ txt; _ }, payload), [])
+  | Ast_503.Parsetree.Psig_extension (({ txt; _ }, payload), attr)
     when String.equal txt Encoding_504.Ext_name.bivariant_psig ->
-      let desc = Encoding_504.To_503.decode_bivariant_psig ~loc payload in
+      let desc = Encoding_504.To_503.decode_bivariant_psig ~loc payload attr in
       copy_signature_item_desc_with_loc ~loc desc
   | Ast_503.Parsetree.Psig_extension (x0, x1) ->
       Ast_504.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1)
