diff --git a/ocaml/testsuite/tests/typing-implicit-source-positions/let_operators.ml b/ocaml/testsuite/tests/typing-implicit-source-positions/let_operators.ml index cd32178946d..125e70104ca 100644 --- a/ocaml/testsuite/tests/typing-implicit-source-positions/let_operators.ml +++ b/ocaml/testsuite/tests/typing-implicit-source-positions/let_operators.ml @@ -48,7 +48,7 @@ let _ = val ( >>| ) : call_pos:[%call_pos] -> 'a -> (lexing_position * 'a -> 'b) -> 'b = - : lexing_position = -{pos_fname = ""; pos_lnum = 3; pos_bol = 1128; pos_cnum = 1130} +{pos_fname = ""; pos_lnum = 3; pos_bol = 1128; pos_cnum = 1132} |}] (* TEST diff --git a/ocaml/testsuite/tests/typing-implicit-source-positions/object_system.ml b/ocaml/testsuite/tests/typing-implicit-source-positions/object_system.ml index 19cf1da9e0e..61c74477f47 100644 --- a/ocaml/testsuite/tests/typing-implicit-source-positions/object_system.ml +++ b/ocaml/testsuite/tests/typing-implicit-source-positions/object_system.ml @@ -95,7 +95,7 @@ val c : c = val from_method_param : lexing_position = {pos_fname = ""; pos_lnum = 2; pos_bol = 2216; pos_cnum = 2258} val from_class_param : lexing_position = - {pos_fname = ""; pos_lnum = 1; pos_bol = 2197; pos_cnum = 2205} + {pos_fname = ""; pos_lnum = 1; pos_bol = 2197; pos_cnum = 2206} |}] class parent ~(call_pos : [%call_pos]) () = object @@ -123,7 +123,7 @@ let position = (o ())#pos [%%expect{| val o : call_pos:[%call_pos] -> unit -> parent = val position : lexing_position = - {pos_fname = ""; pos_lnum = 4; pos_bol = 2964; pos_cnum = 2979} + {pos_fname = ""; pos_lnum = 4; pos_bol = 2964; pos_cnum = 2980} |}] (* Applying an call_pos argument without a label. *) @@ -140,7 +140,7 @@ Warning 6 [labels-omitted]: label call_pos was omitted in the application of thi val o : call_pos:[%call_pos] -> unit -> parent = val position : lexing_position = - {pos_fname = ""; pos_lnum = 4; pos_bol = 3293; pos_cnum = 3308} + {pos_fname = ""; pos_lnum = 4; pos_bol = 3293; pos_cnum = 3309} |}] @@ -216,7 +216,7 @@ let x, y = (new c ~y:pos_a ())#xy [%%expect{| val x : lexing_position = - {pos_fname = ""; pos_lnum = 1; pos_bol = 5199; pos_cnum = 5210} + {pos_fname = ""; pos_lnum = 1; pos_bol = 5199; pos_cnum = 5211} val y : lexing_position = {pos_fname = "a"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1} |}] diff --git a/ocaml/testsuite/tests/typing-implicit-source-positions/rev_apply_correct_location.ml b/ocaml/testsuite/tests/typing-implicit-source-positions/rev_apply_correct_location.ml new file mode 100644 index 00000000000..11023bb403b --- /dev/null +++ b/ocaml/testsuite/tests/typing-implicit-source-positions/rev_apply_correct_location.ml @@ -0,0 +1,45 @@ +(* TEST + expect; +*) + +let f ~(here : [%call_pos]) x = here, x + +[%%expect + {| +val f : here:[%call_pos] -> 'a -> lexing_position * 'a = +|}] + +let result = () |> f |> f + +(* Importantly, these locations are different. *) +[%%expect + {| +val result : lexing_position * (lexing_position * unit) = + ({pos_fname = ""; pos_lnum = 1; pos_bol = 145; pos_cnum = 169}, + ({pos_fname = ""; pos_lnum = 1; pos_bol = 145; pos_cnum = 164}, ())) +|}] + +class ['a] c : here:[%call_pos] -> 'a -> object + method here : lexing_position * 'a + end = fun ~(here : [%call_pos]) a -> object + method here = here, a + end + +[%%expect{| +class ['a] c : + here:[%call_pos] -> 'a -> object method here : lexing_position * 'a end +|}] + +let obj = (() |> new c |> new c) + +let second_here = fst obj#here +let first_here = fst (snd obj#here)#here + + +[%%expect{| +val obj : unit c c = +val second_here : lexing_position = + {pos_fname = ""; pos_lnum = 1; pos_bol = 710; pos_cnum = 736} +val first_here : lexing_position = + {pos_fname = ""; pos_lnum = 1; pos_bol = 710; pos_cnum = 727} +|}] diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml index 3218cf4f227..e0479915f8e 100644 --- a/ocaml/typing/typecore.ml +++ b/ocaml/typing/typecore.ml @@ -7621,7 +7621,7 @@ and type_apply_arg env ~app_loc ~funct ~index ~position_and_mode ~partial_app (l let arg = type_option_none env (instance ty_arg) Location.none in (lbl, Arg (arg, Mode.Value.legacy, sort_arg)) | Position _ -> - let arg = src_pos (Location.ghostify app_loc) [] env in + let arg = src_pos (Location.ghostify funct.exp_loc) [] env in (lbl, Arg (arg, Mode.Value.legacy, sort_arg)) | Labelled _ | Nolabel -> assert false) | Omitted _ as arg -> (lbl, arg)