Skip to content

Commit d6fd03b

Browse files
voodoosvoodoos
authored
Merge pull request #1994 from xvw/short-path-test-xvw
Some more short-path tests
2 parents 7bb461a + 67a5348 commit d6fd03b

9 files changed

+514
-0
lines changed

‎tests/test-dirs/short-paths/short-paths-abbrev.t‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
Alias on virtual classes
2+
3+
$ cat > sample.ml <<EOF
4+
> class type a = object
5+
> method foo : int -> int
6+
> end
7+
> type t = a
8+
> let f (a: a) x = a#foo x
9+
> EOF
10+
$ $MERLIN single type-enclosing -position 5:5 -filename sample.ml < sample.ml \
11+
> | jq .value[0].type -r
12+
a -> int -> int
13+
14+
$ $MERLIN single type-enclosing -short-paths -position 5:5 -filename sample.ml < sample.ml \
15+
> | jq .value[0].type -r
16+
t -> int -> int
17+
18+
Alias on concrete classes
19+
20+
$ cat > sample.ml <<EOF
21+
> class a ~foo = object
22+
> val bar = foo + 1
23+
> method f () = bar
24+
> end
25+
> type t = a
26+
> let f foo = new a ~foo
27+
> EOF
28+
$ $MERLIN single type-enclosing -position 6:5 -filename sample.ml < sample.ml \
29+
> | jq .value[0].type -r
30+
int -> a
31+
32+
$ $MERLIN single type-enclosing -short-paths -position 6:5 -filename sample.ml < sample.ml \
33+
> | jq .value[0].type -r
34+
int -> t

‎tests/test-dirs/short-paths/short-paths-expanded-record.t‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
Mix and match of alias and primitive types
2+
3+
$ cat > sample.ml <<EOF
4+
> type s = string
5+
> type i = int
6+
> type t = {
7+
> a: int
8+
> ; b: i * int * s * string
9+
> ; c: (i, string) result
10+
> }
11+
> let f a b c = {a; b; c}
12+
> EOF
13+
$ $MERLIN single type-enclosing -position 8:5 -filename sample.ml < sample.ml \
14+
> | tr '\r\n' ' ' \
15+
> | jq .value[0].type -r
16+
int -> i * int * s * string -> (i, string) result -> t
17+
18+
$ $MERLIN single type-enclosing -short-paths -position 8:5 -filename sample.ml < sample.ml \
19+
> | tr '\r\n' ' ' \
20+
> | jq .value[0].type -r
21+
i -> i * i * s * s -> (i, s) result -> t
22+
23+
Mix and match of alias and primitive types with opening
24+
25+
$ cat > sample.ml <<EOF
26+
> type s = string
27+
> type i = int
28+
> type t = {
29+
> a: int
30+
> ; b: i * int * s * string
31+
> ; c: (i, string) result
32+
> }
33+
> module M = struct
34+
> type new_string = s
35+
> type new_int = i
36+
> end
37+
> open M
38+
> let f a b c = {a; b; c}
39+
> EOF
40+
$ $MERLIN single type-enclosing -position 13:5 -filename sample.ml < sample.ml \
41+
> | tr '\r\n' ' ' \
42+
> | jq .value[0].type -r
43+
int -> i * int * s * string -> (i, string) result -> t
44+
45+
$ $MERLIN single type-enclosing -short-paths -position 13:5 -filename sample.ml < sample.ml \
46+
> | tr '\r\n' ' ' \
47+
> | jq .value[0].type
48+
"new_int -> new_int * new_int * new_string * new_string -> (new_int, new_string) result -> t"

‎tests/test-dirs/short-paths/short-paths-fragmented-paths.t‎

Lines changed: 100 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,100 @@
1+
Some variation on partial opening
2+
3+
$ cat > sample.ml <<EOF
4+
> module A = struct
5+
> module B = struct
6+
> type t = string
7+
> module C = struct
8+
> type nonrec t =
9+
> | Foo of string
10+
> | Bar of t
11+
> end
12+
> type c = C.t
13+
> end
14+
> type r = B.c
15+
> end
16+
> open A
17+
> let f x y = (A.B.C.Foo x, A.B.C.Bar y)
18+
> EOF
19+
$ $MERLIN single type-enclosing -position 14:5 -filename sample.ml < sample.ml \
20+
> | jq .value[0].type -r
21+
string -> A.B.t -> A.B.C.t * A.B.C.t
22+
23+
$ $MERLIN single type-enclosing -short-paths -position 14:5 -filename sample.ml < sample.ml \
24+
> | jq .value[0].type -r
25+
string -> string -> r * r
26+
27+
28+
$ cat > sample.ml <<EOF
29+
> module A = struct
30+
> module B = struct
31+
> type t = string
32+
> module C = struct
33+
> type nonrec t =
34+
> | Foo of string
35+
> | Bar of t
36+
> end
37+
> type c = C.t
38+
> end
39+
> type r = B.c
40+
> end
41+
> open A.B
42+
> let f x y = (A.B.C.Foo x, A.B.C.Bar y)
43+
> EOF
44+
$ $MERLIN single type-enclosing -position 14:5 -filename sample.ml < sample.ml \
45+
> | jq .value[0].type -r
46+
string -> A.B.t -> A.B.C.t * A.B.C.t
47+
48+
$ $MERLIN single type-enclosing -short-paths -position 14:5 -filename sample.ml < sample.ml \
49+
> | jq .value[0].type -r
50+
t -> t -> c * c
51+
52+
$ cat > sample.ml <<EOF
53+
> module A = struct
54+
> module B = struct
55+
> type t = string
56+
> module C = struct
57+
> type nonrec t =
58+
> | Foo of string
59+
> | Bar of t
60+
> end
61+
> type c = C.t
62+
> end
63+
> type r = B.c
64+
> end
65+
> open A.B.C
66+
> let f x y = (A.B.C.Foo x, A.B.C.Bar y)
67+
> EOF
68+
$ $MERLIN single type-enclosing -position 14:5 -filename sample.ml < sample.ml \
69+
> | jq .value[0].type -r
70+
string -> A.B.t -> A.B.C.t * A.B.C.t
71+
72+
$ $MERLIN single type-enclosing -short-paths -position 14:5 -filename sample.ml < sample.ml \
73+
> | jq .value[0].type -r
74+
string -> string -> t * t
75+
76+
$ cat > sample.ml <<EOF
77+
> module A = struct
78+
> module B = struct
79+
> type t = string
80+
> module C = struct
81+
> type nonrec t =
82+
> | Foo of string
83+
> | Bar of t
84+
> end
85+
> type c = C.t
86+
> end
87+
> type r = B.c
88+
> end
89+
> open A
90+
> open B
91+
> open C
92+
> let f x y = (A.B.C.Foo x, A.B.C.Bar y)
93+
> EOF
94+
$ $MERLIN single type-enclosing -position 16:5 -filename sample.ml < sample.ml \
95+
> | jq .value[0].type -r
96+
string -> A.B.t -> A.B.C.t * A.B.C.t
97+
98+
$ $MERLIN single type-enclosing -short-paths -position 16:5 -filename sample.ml < sample.ml \
99+
> | jq .value[0].type -r
100+
t -> t -> c * c

‎tests/test-dirs/short-paths/short-paths-functors.t‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
$ cat > sample.ml <<EOF
2+
> module F (D: sig type t val from_int : int -> t end) : sig
3+
> type t
4+
> val make : int -> t
5+
> end = struct
6+
> type t = D.t
7+
> let make x = D.from_int x
8+
> end
9+
> module A = F (struct type t = int let from_int x = x)
10+
> module B = F (struct type t = int let from_int x = x)
11+
> open A
12+
> let f x = B.make (A.make x)
13+
> EOF
14+
$ $MERLIN single type-enclosing -position 11:5 -filename sample.ml < sample.ml \
15+
> | tr '\r\n' ' ' \
16+
> | jq .value[0].type -r
17+
int -> B.t
18+
19+
$ $MERLIN single type-enclosing -short-paths -position 11:5 -filename sample.ml < sample.ml \
20+
> | tr '\r\n' ' ' \
21+
> | jq .value[0].type -r
22+
int -> B.t
23+
24+
$ cat > sample.ml <<EOF
25+
> module F (D: sig type t val from_int : int -> t end) : sig
26+
> type t
27+
> val make : int -> t
28+
> end = struct
29+
> type t = D.t
30+
> let make x = D.from_int x
31+
> end
32+
> module A = F (struct type t = int let from_int x = x)
33+
> module B = F (struct type t = int let from_int x = x)
34+
> open B
35+
> let f x = B.make (A.make x)
36+
> EOF
37+
$ $MERLIN single type-enclosing -position 11:5 -filename sample.ml < sample.ml \
38+
> | tr '\r\n' ' ' \
39+
> | jq .value[0].type -r
40+
int -> B.t
41+
42+
$ $MERLIN single type-enclosing -short-paths -position 11:5 -filename sample.ml < sample.ml \
43+
> | tr '\r\n' ' ' \
44+
> | jq .value[0].type -r
45+
int -> t

‎tests/test-dirs/short-paths/short-paths-gadts-index.t‎

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
GADT indexation through aliases
2+
3+
$ cat > sample.ml <<EOF
4+
> type _ g =
5+
> | A : int g
6+
> | B : string g
7+
> | C : (int, string) result g
8+
> type i = int
9+
> type s = string
10+
> let f = (A, B, C)
11+
> EOF
12+
$ $MERLIN single type-enclosing -position 7:6 -filename sample.ml < sample.ml \
13+
> | tr '\r\n' ' ' \
14+
> | jq .value[0].type -r
15+
int g * string g * (int, string) result g
16+
17+
$ $MERLIN single type-enclosing -short-paths -position 7:6 -filename sample.ml < sample.ml \
18+
> | tr '\r\n' ' ' \
19+
> | jq .value[0].type -r
20+
i g * s g * (i, s) result g
21+
22+
GADT indexation through aliases with abstraction
23+
24+
$ cat > sample.ml <<EOF
25+
> module M : sig
26+
> type 'a g
27+
> val a : int g
28+
> val b : string g
29+
> val c : (int, string) result g
30+
> end = struct
31+
> type _ g =
32+
> | A : int g
33+
> | B : string g
34+
> | C : (int, string) result g
35+
> let (a, b, c) = (A, B, C)
36+
> end
37+
> open M
38+
> let f = (a, b, c)
39+
> EOF
40+
$ $MERLIN single type-enclosing -position 14:5 -filename sample.ml < sample.ml \
41+
> | tr '\r\n' ' ' \
42+
> | jq .value[0].type -r
43+
int M.g * string M.g * (int, string) result M.g
44+
45+
$ $MERLIN single type-enclosing -short-paths -position 14:5 -filename sample.ml < sample.ml \
46+
> | tr '\r\n' ' ' \
47+
> | jq .value[0].type -r
48+
int g * string g * (int, string) result g
49+
50+
GADT indexation through aliases with abstraction at call-site
51+
52+
$ cat > sample.ml <<EOF
53+
> module M : sig
54+
> type 'a g
55+
> val a : int g
56+
> val b : string g
57+
> val c : (int, string) result g
58+
> end = struct
59+
> type _ g =
60+
> | A : int g
61+
> | B : string g
62+
> | C : (int, string) result g
63+
> let (a, b, c) = (A, B, C)
64+
> end
65+
> type aaa = string type bbb = int type ccc = (int, string) result
66+
> open M
67+
> let f = (a, b, c)
68+
> EOF
69+
$ $MERLIN single type-enclosing -position 15:5 -filename sample.ml < sample.ml \
70+
> | tr '\r\n' ' ' \
71+
> | jq .value[0].type -r
72+
int M.g * string M.g * (int, string) result M.g
73+
74+
$ $MERLIN single type-enclosing -short-paths -position 15:5 -filename sample.ml < sample.ml \
75+
> | tr '\r\n' ' ' \
76+
> | jq .value[0].type -r
77+
bbb g * aaa g * (bbb, aaa) result g

‎tests/test-dirs/short-paths/short-paths-include-struct.t‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
# Type exposed by include struct without ascription
2+
3+
$ cat > sample.ml <<EOF
4+
> include struct
5+
> type 'a t = 'a option
6+
> end
7+
> let f x = Some x
8+
> EOF
9+
$ $MERLIN single type-enclosing -position 4:5 -filename sample.ml < sample.ml \
10+
> | tr '\r\n' ' ' \
11+
> | jq .value[0].type -r
12+
'a -> 'a option
13+
14+
$ $MERLIN single type-enclosing -short-paths -position 4:5 -filename sample.ml < sample.ml \
15+
> | tr '\r\n' ' ' \
16+
> | jq .value[0].type -r
17+
'a -> 'a t
18+
19+
# Type exposed by include struct with ascription
20+
21+
$ cat > sample.ml <<EOF
22+
> include struct
23+
> type 'a t = 'a option
24+
> end
25+
> let f x : int -> int option = Some x
26+
> EOF
27+
$ $MERLIN single type-enclosing -position 4:5 -filename sample.ml < sample.ml \
28+
> | tr '\r\n' ' ' \
29+
> | jq .value[0].type -r
30+
'a -> int -> int option
31+
32+
$ $MERLIN single type-enclosing -short-paths -position 4:5 -filename sample.ml < sample.ml \
33+
> | tr '\r\n' ' ' \
34+
> | jq .value[0].type -r
35+
'a -> int -> int t

0 commit comments

Comments
 (0)