Skip to content

Commit f5f2f84

Browse files
committed
cover another case
1 parent f5bb9e9 commit f5f2f84

File tree

3 files changed

+49
-8
lines changed

3 files changed

+49
-8
lines changed

compiler/ml/typedecl.ml

Lines changed: 34 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -256,6 +256,12 @@ let transl_labels ?record_name env closed lbls =
256256
in
257257
(lbls, lbls')
258258

259+
let first_non_spread_field (lbls_ : Parsetree.label_declaration list) =
260+
List.find_map
261+
(fun (ld : Parsetree.label_declaration) ->
262+
if ld.pld_name.txt <> "..." then Some ld else None)
263+
lbls_
264+
259265
let transl_constructor_arguments env closed = function
260266
| Pcstr_tuple l ->
261267
let l = List.map (transl_simple_type env closed) l in
@@ -271,15 +277,40 @@ let transl_constructor_arguments env closed = function
271277
match l with
272278
| [{pld_name = {txt = "..."}; pld_type = spread_typ; _}] ->
273279
(* Ambiguous `{...t}`: if only spread present and it doesn't resolve to a
274-
record type, treat it as an object-typed tuple argument. *)
280+
record type, treat it as an object-typed tuple argument. *)
275281
let obj_ty =
276282
Ast_helper.Typ.object_ ~loc:spread_typ.ptyp_loc
277283
[Parsetree.Oinherit spread_typ]
278284
Asttypes.Closed
279285
in
280286
let cty = transl_simple_type env closed obj_ty in
281287
(Types.Cstr_tuple [cty.ctyp_type], Cstr_tuple [cty])
282-
| _ -> (Types.Cstr_record lbls', Cstr_record lbls)))
288+
| _ -> (
289+
(* Could not resolve spread to a record type, but additional record
290+
fields are present. Mirror declaration logic and reject mixing
291+
object-type spreads with record fields. *)
292+
match first_non_spread_field l with
293+
| Some ld ->
294+
raise
295+
(Error (ld.pld_loc, Object_spread_with_record_field ld.pld_name.txt))
296+
| None -> (
297+
(* Be defensive: treat as an object-typed tuple if somehow only spreads
298+
are present but not caught by the single-spread case. *)
299+
let fields =
300+
Ext_list.filter_map l (fun ld ->
301+
match ld.pld_name.txt with
302+
| "..." -> Some (Parsetree.Oinherit ld.pld_type)
303+
| _ -> None)
304+
in
305+
match fields with
306+
| [] -> (Types.Cstr_record lbls', Cstr_record lbls)
307+
| _ ->
308+
let obj_ty =
309+
Ast_helper.Typ.object_ ~loc:(List.hd l).pld_loc fields
310+
Asttypes.Closed
311+
in
312+
let cty = transl_simple_type env closed obj_ty in
313+
(Types.Cstr_tuple [cty.ctyp_type], Cstr_tuple [cty])))))
283314

284315
let make_constructor env type_path type_params sargs sret_type =
285316
match sret_type with
@@ -633,12 +664,7 @@ let transl_declaration ~type_record_as_object ~untagged_wfc env sdecl id =
633664
(* TODO: We really really need to make this "spread that needs to be resolved"
634665
concept 1st class in the AST or similar. This is quite hacky and fragile as
635666
is.*)
636-
let non_spread_field =
637-
List.find_map
638-
(fun ld -> if ld.pld_name.txt <> "..." then Some ld else None)
639-
lbls_
640-
in
641-
match non_spread_field with
667+
match first_non_spread_field lbls_ with
642668
| Some ld ->
643669
(* Error on the first record field mixed with an object spread. *)
644670
raise
Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
2+
We've found a bug for you!
3+
/.../fixtures/mix_object_record_spread_constructor.res:4:16-28
4+
5+
2 │
6+
3 │ type t =
7+
4 │ | V({...obj, label: string})
8+
5 │
9+
10+
You cannot mix a record field with an object type spread.
11+
Remove the record field or change it to an object field (e.g. "label": ...).
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
type obj = {"name": string}
2+
3+
type t =
4+
| V({...obj, label: string})

0 commit comments

Comments
 (0)