Skip to content

Commit cbd5e54

Browse files
authored
Fix warning 34 (unused type declaration) for locally-abstract types (#2683)
* Regression test with bad output * Fix
1 parent 7d944ef commit cbd5e54

File tree

2 files changed

+72
-8
lines changed

2 files changed

+72
-8
lines changed

ocaml/testsuite/tests/typing-warnings/unused_types.ml

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -530,3 +530,66 @@ Warning 69 [unused-field]: unused record field b.
530530

531531
module Unused_field_disable_one_warning : sig end
532532
|}]
533+
534+
(* Locally abstract types *)
535+
536+
let u (type unused) = ()
537+
[%%expect {|
538+
Line 1, characters 12-18:
539+
1 | let u (type unused) = ()
540+
^^^^^^
541+
Warning 34 [unused-type-declaration]: unused type unused.
542+
543+
val u : unit = ()
544+
|}]
545+
546+
let u = fun (type unused) -> ()
547+
[%%expect {|
548+
Line 1, characters 18-24:
549+
1 | let u = fun (type unused) -> ()
550+
^^^^^^
551+
Warning 34 [unused-type-declaration]: unused type unused.
552+
553+
val u : unit = ()
554+
|}]
555+
556+
let f (type unused) x = x
557+
[%%expect {|
558+
Line 1, characters 12-18:
559+
1 | let f (type unused) x = x
560+
^^^^^^
561+
Warning 34 [unused-type-declaration]: unused type unused.
562+
563+
val f : 'a -> 'a = <fun>
564+
|}]
565+
566+
let f = fun (type unused) x -> x
567+
[%%expect {|
568+
Line 1, characters 18-24:
569+
1 | let f = fun (type unused) x -> x
570+
^^^^^^
571+
Warning 34 [unused-type-declaration]: unused type unused.
572+
573+
val f : 'a -> 'a = <fun>
574+
|}]
575+
576+
let f (type used unused) (x : used) = x
577+
[%%expect {|
578+
Line 1, characters 17-23:
579+
1 | let f (type used unused) (x : used) = x
580+
^^^^^^
581+
Warning 34 [unused-type-declaration]: unused type unused.
582+
583+
val f : 'used -> 'used = <fun>
584+
|}]
585+
586+
let f = fun (type used unused) (x : used) -> x
587+
588+
[%%expect{|
589+
Line 1, characters 23-29:
590+
1 | let f = fun (type used unused) (x : used) -> x
591+
^^^^^^
592+
Warning 34 [unused-type-declaration]: unused type unused.
593+
594+
val f : 'used -> 'used = <fun>
595+
|}]

ocaml/typing/typecore.ml

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -6249,7 +6249,7 @@ and type_expect_
62496249
in
62506250
re { exp with exp_extra =
62516251
(Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
6252-
| Pexp_newtype({txt=name}, sbody) ->
6252+
| Pexp_newtype(name, sbody) ->
62536253
type_newtype_expr ~loc ~env ~expected_mode ~rue ~attributes:sexp.pexp_attributes
62546254
name None sbody
62556255
| Pexp_pack m ->
@@ -6687,7 +6687,7 @@ and type_function
66876687
(* Check everything else in the scope of (type a). *)
66886688
let (params, body, newtypes, contains_gadt, fun_alloc_mode, ret_info),
66896689
exp_type, jkind_annot =
6690-
type_newtype loc env newtype_var.txt jkind_annot (fun env ->
6690+
type_newtype env newtype_var jkind_annot (fun env ->
66916691
let { function_ = exp_type, params, body;
66926692
newtypes; params_contain_gadt = contains_gadt;
66936693
fun_alloc_mode; ret_info;
@@ -8282,9 +8282,10 @@ and type_function_cases_expect
82828282
by the user.
82838283
*)
82848284
and type_newtype
8285-
: type a. _ -> _ -> _ -> _ -> (Env.t -> a * type_expr)
8285+
: type a. _ -> _ -> _ -> (Env.t -> a * type_expr)
82868286
-> a * type_expr * Jkind.annotation option =
8287-
fun loc env name jkind_annot_opt type_body ->
8287+
fun env name jkind_annot_opt type_body ->
8288+
let { txt = name; loc = name_loc } : _ Location.loc = name in
82888289
let jkind, jkind_annot =
82898290
Jkind.of_annotation_option_default ~context:(Newtype_declaration name)
82908291
~default:(Jkind.value ~why:Univar) jkind_annot_opt
@@ -8298,7 +8299,7 @@ and type_newtype
82988299
(* Use [with_local_level] just for scoping *)
82998300
with_local_level begin fun () ->
83008301
(* Create a fake abstract type declaration for name. *)
8301-
let decl = new_local_type ~loc jkind ~jkind_annot in
8302+
let decl = new_local_type ~loc:name_loc jkind ~jkind_annot in
83028303
let scope = create_scope () in
83038304
let (id, new_env) = Env.enter_type ~scope name decl env in
83048305

@@ -8324,15 +8325,15 @@ and type_newtype
83248325
and type_newtype_expr
83258326
~loc ~env ~expected_mode ~rue ~attributes name jkind_annot_opt sbody =
83268327
let body, ety, jkind_annot =
8327-
type_newtype loc env name jkind_annot_opt (fun env ->
8328+
type_newtype env name jkind_annot_opt (fun env ->
83288329
let expr = type_exp env expected_mode sbody in
83298330
expr, expr.exp_type)
83308331
in
83318332
(* non-expansive if the body is non-expansive, so we don't introduce
83328333
any new extra node in the typed AST. *)
83338334
rue { body with exp_loc = loc; exp_type = ety;
83348335
exp_extra =
8335-
(Texp_newtype (name, jkind_annot),
8336+
(Texp_newtype (name.txt, jkind_annot),
83368337
loc, attributes) :: body.exp_extra }
83378338

83388339
(* Typing of let bindings *)
@@ -9214,7 +9215,7 @@ and type_jkind_expr
92149215
~loc ~env ~expected_mode ~ty_expected:_ ~explanation:_ ~rue ~attributes
92159216
: Jane_syntax.Layouts.expression -> _ = function
92169217
| Lexp_constant x -> type_unboxed_constant ~loc ~env ~rue ~attributes x
9217-
| Lexp_newtype ({txt=name}, jkind_annot, sbody) ->
9218+
| Lexp_newtype (name, jkind_annot, sbody) ->
92189219
type_newtype_expr ~loc ~env ~expected_mode ~rue ~attributes
92199220
name (Some jkind_annot) sbody
92209221

0 commit comments

Comments
 (0)