Duplicate Ccatch handler label #11887
Description
With closure, ocamlopt generates multiple Ccatch statements with the same handler label in one function, violating one of the invariants that linearize relies on for safety. I haven't been able to make an example that crashes or miscompiles, but the following program fails -dcmm-invariants check availabel in 4.13.0 and later. The problem is present since at least 4.11.0. Sorry I haven't been able to minimize the example any further.
type ('a, 'b) result =
| Ok of 'a
| Error of 'b
module S = struct
type t =
[
`B0
(* renaming the following variants makes the problem go away *)
| `CA
| `CH
| `CI
| `CL
| `Other of string
]
end
type a1 = [ `CA ]
type a2 = [ `CH ]
type a3 = [ `CL ]
let ok = Ok ()
let error s =
Error s
let foo =
let current =
let module T = struct
type a1 =
[ `Common
| `Uuuu
| `Ssss
| `Rrrr
]
type a2 = [ `Common ]
type a3 =
[ `Common ]
end
in
fun ~s typ ->
match s with
| `None -> error s
| #a1 ->
(match typ with
| #T.a1 -> ok
| _ -> error s)
| #a2 ->
(match typ with
| #T.a2 -> ok
| _ -> error s)
| #a3 ->
(match typ with
| #T.a3 -> ok
| _ -> error s)
| #S.t -> error s
in
current
Compiling with ocamlopt.opt t2.ml -c -dcmm -dump-into-file produces the following Cmm in which with(1) is repeated in some (but not all) cases:
(function{t2.ml:43,4-368} camlT2__fun_375 (s/360: val typ/361: val)
(catch
(if (and s/360 1)
(if (>= s/360 30013)
(if (>= s/360 1741061553)
(alloc{t2.ml:25,2-9} block-hdr(1025){t2.ml:25,2-9} s/360)
(catch
(switch (>>s (+ s/360 -30012) 1)
case 0:
(catch
(catch
(if (>= typ/361 1830078275)
(if (!= typ/361 1852357313)
(if (!= typ/361 1896915393) (exit 2) (exit 1)) (exit 1))
(if (!= typ/361 -142224745)
(if (>= typ/361 1830078273) (exit 1) (exit 2)) (exit 1)))
with(2)
(alloc{t2.ml:25,2-9} block-hdr(1025){t2.ml:25,2-9} s/360))
with(1) "camlT2__2")
case 1:
(catch
(catch
(if (>= typ/361 1830078275)
(if (!= typ/361 1852357313)
(if (!= typ/361 1896915393) (exit 2) (exit 1)) (exit 1))
(if (!= typ/361 -142224745)
(if (>= typ/361 1830078273) (exit 1) (exit 2)) (exit 1)))
with(2)
(alloc{t2.ml:25,2-9} block-hdr(1025){t2.ml:25,2-9} s/360))
with(1) "camlT2__2")
case 2:
(catch
(catch
(if (>= typ/361 1830078275)
(if (!= typ/361 1852357313)
(if (!= typ/361 1896915393) (exit 2) (exit 1)) (exit 1))
(if (!= typ/361 -142224745)
(if (>= typ/361 1830078273) (exit 1) (exit 2)) (exit 1)))
with(2)
(alloc{t2.ml:25,2-9} block-hdr(1025){t2.ml:25,2-9} s/360))
with(1) "camlT2__2")
...
Metadata
Metadata
Assignees
Labels
No labels