aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2020-03-26 16:08:37 +0100
committerPierre-Marie Pédrot2020-03-26 16:08:37 +0100
commit738445a8db2b853204ea6f04b6b07751aeb40833 (patch)
tree2997b7c2db8a431cbbbc4ef7552817955dcb7ba7
parentfde8e449ca4a796e7dee55c6a518e8161e448f23 (diff)
parenta4d6176698f761cfd90ee63f051477c5386d657d (diff)
Merge PR #11918: Fix #11845: anomaly when including partially applied functor
Reviewed-by: ppedrot
-rw-r--r--kernel/modops.ml30
-rw-r--r--test-suite/bugs/closed/bug_11845.v6
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.