summaryrefslogtreecommitdiff
path: root/testsuite/tests/backtrace/names.ml
blob: 06fc9ddffd5cb22b7d2330e1a149cdc4a2e4a767 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(* TEST
   flags = "-g"
 *)


let id x = Sys.opaque_identity x

let[@inline never] bang () = raise Exit


let[@inline never] fn_multi _ _ f = f 42 + 1

let[@inline never] fn_function = function
  | f -> f 42 + 1

let[@inline never] fn_poly : 'a . 'a -> ('a -> int) -> int = fun x f ->
  f x + 1

module Mod1 = struct
  module Nested = struct
    let[@inline never] apply f = f 42 + 1
  end
end

let[@inline never] anon f =
  let fn = id (fun () -> f 42 + 1) in
  fn ()

let[@inline never] double_anon f =
  let fn = id (fun () ->
    let fn = id (fun () ->
      f 42 + 1) in
    fn ()) in
  fn ()

let[@inline never] local f =
  let[@inline never] inner () = f 42 + 1 in
  (id inner) () + 1

let[@inline never] double_local f =
  let inner1 () =
    let inner2 () = f 42 + 1 in
    (id inner2) () + 1 in
  (id inner1) () + 1

let local_no_arg =
  let inner f = f 42 + 1 in
  fun[@inline never] f -> (id inner) f + 1

let[@inline never] curried () =
  let inner () f = f 42 in
  id (inner ())

let[@inline never] local_module f =
  let module N = struct
    let[@inline never] foo () =
      f 42 + 1
    let r = ref 0    let () = r := id (id foo ())
  end in
  !N.r

module Functor (X : sig end) = struct
  let[@inline never] fn f = f 42 + 1
end
module Inst = Functor (struct end)

module rec Rec1 : sig
  val fn : (int -> int) -> int
end = struct
  module M = Rec2 (struct end)
  let[@inline never] fn f = M.fn f + 1
end
and Rec2 : functor (X : sig end) -> sig
  val fn : (int -> int) -> int
end = functor (X : sig end) -> struct
  let[@inline never] fn f = f 42 + 1
end

let[@inline never] (+@+) n f = f 42 + 1

class klass = object (self)
  val other = new klass2 "asdf"
  method meth f : int =
    other#othermeth 1 1 f 1 + 1
end
and klass2 _v = object (self)
  method othermeth _ _ f _ =
    (id (fun g -> g 42 + 1) f) + 1
end

let inline_object f =
  let obj = object (self)
    method meth : int =
      self#othermeth 1 f 1 + 1
    method othermeth _ _ _ =
      f 42 + 1
  end in
  obj#meth

let () =
  Printexc.record_backtrace true;
  match
    fn_multi 1 1 @@ fun _ ->
    fn_function @@ fun _ ->
    fn_poly 42 @@ fun _ ->
    Mod1.Nested.apply @@ fun _ ->
    anon @@ fun _ ->
    double_anon @@ fun _ ->
    local @@ fun _ ->
    double_local @@ fun _ ->
    local_no_arg @@ fun _ ->
    curried () @@ fun _ ->
    local_module @@ fun _ ->
    Inst.fn @@ fun _ ->
    Rec1.fn @@ fun _ ->
    42 +@+ fun _ ->
    (new klass)#meth @@ fun _ ->
    inline_object @@ fun _ ->
    bang ()
  with
  | _ -> assert false
  | exception Exit ->
     Printexc.print_backtrace stdout