diff options
| author | Pierre-Marie Pédrot | 2020-03-26 16:08:37 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2020-03-26 16:08:37 +0100 |
| commit | 738445a8db2b853204ea6f04b6b07751aeb40833 (patch) | |
| tree | 2997b7c2db8a431cbbbc4ef7552817955dcb7ba7 | |
| parent | fde8e449ca4a796e7dee55c6a518e8161e448f23 (diff) | |
| parent | a4d6176698f761cfd90ee63f051477c5386d657d (diff) | |
Merge PR #11918: Fix #11845: anomaly when including partially applied functor
Reviewed-by: ppedrot
| -rw-r--r-- | kernel/modops.ml | 30 | ||||
| -rw-r--r-- | test-suite/bugs/closed/bug_11845.v | 6 |
2 files changed, 21 insertions, 15 deletions
diff --git a/kernel/modops.ml b/kernel/modops.ml index 5dd5499a26..301af328e4 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -382,21 +382,21 @@ let inline_delta_resolver env inl mp mbid mtb delta = let rec make_inline delta = function | [] -> delta | (lev,kn)::r -> - let kn = replace_mp_in_kn (MPbound mbid) mp kn in - let con = constant_of_delta_kn delta kn in - try - let constant = lookup_constant con env in - let l = make_inline delta r in - match constant.const_body with - | Undef _ | OpaqueDef _ | Primitive _ -> l - | Def body -> - let constr = Mod_subst.force_constr body in - let ctx = Declareops.constant_polymorphic_context constant in - let constr = Univ.{univ_abstracted_value=constr; univ_abstracted_binder=ctx} in - add_inline_delta_resolver kn (lev, Some constr) l - with Not_found -> - error_no_such_label_sub (Constant.label con) - (ModPath.to_string (Constant.modpath con)) + let kn = replace_mp_in_kn (MPbound mbid) mp kn in + let con = constant_of_delta_kn delta kn in + if not (Environ.mem_constant con env) then + error_no_such_label_sub (Constant.label con) + (ModPath.to_string (Constant.modpath con)) + else + let constant = lookup_constant con env in + let l = make_inline delta r in + match constant.const_body with + | Undef _ | OpaqueDef _ | Primitive _ -> l + | Def body -> + let constr = Mod_subst.force_constr body in + let ctx = Declareops.constant_polymorphic_context constant in + let constr = Univ.{univ_abstracted_value=constr; univ_abstracted_binder=ctx} in + add_inline_delta_resolver kn (lev, Some constr) l in make_inline delta constants diff --git a/test-suite/bugs/closed/bug_11845.v b/test-suite/bugs/closed/bug_11845.v new file mode 100644 index 0000000000..d27f8c4ef0 --- /dev/null +++ b/test-suite/bugs/closed/bug_11845.v @@ -0,0 +1,6 @@ + +Module Type T. Parameter Inline v : Prop. End T. + +Module F(A:T). End F. + +Fail Include F. |
