From b6733f0507e3e04fb6130b3f82a79e8835e1062f Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 31 May 2017 00:30:00 +0200 Subject: Bump year in headers. --- test-suite/bench/lists-100.v | 2 +- test-suite/bench/lists_100.v | 2 +- test-suite/failure/Tauto.v | 2 +- test-suite/failure/clash_cons.v | 2 +- test-suite/failure/fixpoint1.v | 2 +- test-suite/failure/guard.v | 2 +- test-suite/failure/illtype1.v | 2 +- test-suite/failure/positivity.v | 2 +- test-suite/failure/redef.v | 2 +- test-suite/failure/search.v | 2 +- test-suite/ideal-features/Apply.v | 2 +- test-suite/misc/berardi_test.v | 2 +- test-suite/success/Check.v | 2 +- test-suite/success/Field.v | 2 +- test-suite/success/Tauto.v | 2 +- test-suite/success/TestRefine.v | 2 +- test-suite/success/eauto.v | 2 +- test-suite/success/eqdecide.v | 2 +- test-suite/success/extraction.v | 2 +- test-suite/success/inds_type_sec.v | 2 +- test-suite/success/induct.v | 2 +- test-suite/success/mutual_ind.v | 2 +- test-suite/success/unfold.v | 2 +- test-suite/typeclasses/NewSetoid.v | 2 +- 24 files changed, 24 insertions(+), 24 deletions(-) (limited to 'test-suite') diff --git a/test-suite/bench/lists-100.v b/test-suite/bench/lists-100.v index 5c64716c7..eba1e01d7 100644 --- a/test-suite/bench/lists-100.v +++ b/test-suite/bench/lists-100.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* Date: Tue, 21 Feb 2017 12:56:28 +0100 Subject: Univs: fix bug #5365, generation of u+k <= v constraints Use an explicit label ~algebraic for make_flexible_variable as well. --- engine/evd.ml | 5 +++-- engine/evd.mli | 4 +++- engine/uState.ml | 13 +++++++++---- engine/uState.mli | 9 ++++++++- pretyping/evarsolve.ml | 2 +- test-suite/bugs/closed/5365.v | 13 +++++++++++++ toplevel/command.ml | 2 +- toplevel/record.ml | 2 +- 8 files changed, 39 insertions(+), 11 deletions(-) create mode 100644 test-suite/bugs/closed/5365.v (limited to 'test-suite') diff --git a/engine/evd.ml b/engine/evd.ml index c2f848291..ac31728f4 100644 --- a/engine/evd.ml +++ b/engine/evd.ml @@ -809,8 +809,9 @@ let new_sort_variable ?loc ?name rigid d = let add_global_univ d u = { d with universes = UState.add_global_univ d.universes u } -let make_flexible_variable evd b u = - { evd with universes = UState.make_flexible_variable evd.universes b u } +let make_flexible_variable evd ~algebraic u = + { evd with universes = + UState.make_flexible_variable evd.universes ~algebraic u } let make_evar_universe_context e l = let uctx = UState.make (Environ.universes e) in diff --git a/engine/evd.mli b/engine/evd.mli index 86887f3dc..93d4a9d15 100644 --- a/engine/evd.mli +++ b/engine/evd.mli @@ -526,7 +526,9 @@ val new_sort_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_ val add_global_univ : evar_map -> Univ.Level.t -> evar_map val universe_rigidity : evar_map -> Univ.Level.t -> rigid -val make_flexible_variable : evar_map -> bool -> Univ.universe_level -> evar_map +val make_flexible_variable : evar_map -> algebraic:bool -> Univ.universe_level -> evar_map +(** See [UState.make_flexible_variable] *) + val is_sort_variable : evar_map -> sorts -> Univ.universe_level option (** [is_sort_variable evm s] returns [Some u] or [None] if [s] is not a local sort variable declared in [evm] *) diff --git a/engine/uState.ml b/engine/uState.ml index c35f97b2e..146a386a2 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -381,16 +381,21 @@ let add_global_univ uctx u = uctx_initial_universes = initial; uctx_universes = univs } -let make_flexible_variable ctx b u = - let {uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in +let make_flexible_variable ctx ~algebraic u = + let {uctx_local = cstrs; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in let uvars' = Univ.LMap.add u None uvars in let avars' = - if b then + if algebraic then let uu = Univ.Universe.make u in let substu_not_alg u' v = Option.cata (fun vu -> Univ.Universe.equal uu vu && not (Univ.LSet.mem u' avars)) false v in - if not (Univ.LMap.exists substu_not_alg uvars) + let has_upper_constraint () = + Univ.Constraint.exists + (fun (l,d,r) -> d == Univ.Lt && Univ.Level.equal l u) + (Univ.ContextSet.constraints cstrs) + in + if not (Univ.LMap.exists substu_not_alg uvars || has_upper_constraint ()) then Univ.LSet.add u avars else avars else avars in diff --git a/engine/uState.mli b/engine/uState.mli index 0cdc6277a..3776e4c9f 100644 --- a/engine/uState.mli +++ b/engine/uState.mli @@ -92,7 +92,14 @@ val emit_side_effects : Safe_typing.private_constants -> t -> t val new_univ_variable : ?loc:Loc.t -> rigid -> string option -> t -> t * Univ.Level.t val add_global_univ : t -> Univ.Level.t -> t -val make_flexible_variable : t -> bool -> Univ.Level.t -> t + +(** [make_flexible_variable g algebraic l] + + Turn the variable [l] flexible, and algebraic if [algebraic] is true + and [l] can be. That is if there are no strict upper constraints on + [l] and and it does not appear in the instance of any non-algebraic + universe. Otherwise the variable is just made flexible. *) +val make_flexible_variable : t -> algebraic:bool -> Univ.Level.t -> t val is_sort_variable : t -> Sorts.t -> Univ.Level.t option diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index 4fd030845..e8380136e 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -67,7 +67,7 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false) else t | UnivFlexible alg -> if onlyalg && alg then - (evdref := Evd.make_flexible_variable !evdref false l; t) + (evdref := Evd.make_flexible_variable !evdref ~algebraic:false l; t) else t)) | Sort (Prop Pos as s) when refreshset && not direction -> (* Cannot make a universe "lower" than "Set", diff --git a/test-suite/bugs/closed/5365.v b/test-suite/bugs/closed/5365.v new file mode 100644 index 000000000..be360d24d --- /dev/null +++ b/test-suite/bugs/closed/5365.v @@ -0,0 +1,13 @@ + +Inductive TupleT : nat -> Type := +| nilT : TupleT 0 +| consT {n} A : (A -> TupleT n) -> TupleT (S n). + +Inductive Tuple : forall n, TupleT n -> Type := + nil : Tuple _ nilT +| cons {n A} (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). + +Inductive TupleMap : forall n, TupleT n -> TupleT n -> Type := + tmNil : TupleMap _ nilT nilT +| tmCons {n} {A B : Type} (F : A -> TupleT n) (G : B -> TupleT n) + : (forall x, sigT (fun y => TupleMap _ (F x) (G y))) -> TupleMap _ (consT A F) (consT B G). diff --git a/toplevel/command.ml b/toplevel/command.ml index a9f2598e2..2d09e8e9d 100644 --- a/toplevel/command.ml +++ b/toplevel/command.ml @@ -427,7 +427,7 @@ let make_conclusion_flexible evdref ty poly = | Type u -> (match Univ.universe_level u with | Some u -> - evdref := Evd.make_flexible_variable !evdref true u + evdref := Evd.make_flexible_variable !evdref ~algebraic:true u | None -> ()) | _ -> () else () diff --git a/toplevel/record.ml b/toplevel/record.ml index 8d35e5a3d..4e5628dfd 100644 --- a/toplevel/record.ml +++ b/toplevel/record.ml @@ -124,7 +124,7 @@ let typecheck_params_and_fields def id pl t ps nots fs = | Sort s' -> (if poly then match Evd.is_sort_variable !evars s' with - | Some l -> evars := Evd.make_flexible_variable !evars true l; + | Some l -> evars := Evd.make_flexible_variable !evars ~algebraic:true l; sred, true | None -> s, false else s, false) -- cgit v1.2.3 From 09cbae6c995c3e94ac8f0e53e6857da8e491a2fe Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Thu, 8 Jun 2017 14:54:39 +0200 Subject: Adding a test case as requested in bug 5205. --- test-suite/bugs/closed/5205.v | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 test-suite/bugs/closed/5205.v (limited to 'test-suite') diff --git a/test-suite/bugs/closed/5205.v b/test-suite/bugs/closed/5205.v new file mode 100644 index 000000000..406f37a4b --- /dev/null +++ b/test-suite/bugs/closed/5205.v @@ -0,0 +1,6 @@ +Definition foo (n : nat) (m : nat) : nat := m. + +Arguments foo {_} _, _ _. + +Check foo 1 1. +Check foo (n:=1) 1. -- cgit v1.2.3 From 849bf3600fe11fea876c9aeea69fe806b0c8c5d8 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Fri, 9 Jun 2017 12:30:42 -0400 Subject: Fix Bug #5568, no dup notation warnings on repeated module imports --- interp/notation.ml | 3 ++- interp/notation.mli | 2 +- interp/notation_ops.ml | 9 ++++++++- test-suite/output/Notations.v | 11 +++++++++++ toplevel/metasyntax.ml | 4 ++-- 5 files changed, 24 insertions(+), 5 deletions(-) (limited to 'test-suite') diff --git a/interp/notation.ml b/interp/notation.ml index 389a1c9df..ba80cf1d2 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -561,11 +561,12 @@ let interpretation_eq (vars1, t1) (vars2, t2) = List.equal var_attributes_eq vars1 vars2 && Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2 -let exists_notation_in_scope scopt ntn r = +let exists_notation_in_scope scopt ntn onlyprint r = let scope = match scopt with Some s -> s | None -> default_scope in try let sc = String.Map.find scope !scope_map in let n = String.Map.find ntn sc.notations in + onlyprint = n.not_onlyprinting && interpretation_eq n.not_interp r with Not_found -> false diff --git a/interp/notation.mli b/interp/notation.mli index 2e92a00a8..303fa8c7a 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -142,7 +142,7 @@ val interp_notation_as_global_reference : Loc.t -> (global_reference -> bool) -> (** Checks for already existing notations *) val exists_notation_in_scope : scope_name option -> notation -> - interpretation -> bool + bool -> interpretation -> bool (** Declares and looks for scopes associated to arguments of a global ref *) val declare_arguments_scope : diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 564882153..26e61d13a 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -47,9 +47,16 @@ let compare_glob_constr f add t1 t2 = match t1,t2 with | GHole _ | GSort _ | GLetIn _), _ -> false +(* helper for NVar, NVar case in eq_notation_constr *) +let get_var_ndx id vs = try Some (List.index Id.equal id vs) with Not_found -> None + let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with | NRef gr1, NRef gr2 -> eq_gr gr1 gr2 -| NVar id1, NVar id2 -> Int.equal (List.index Id.equal id1 vars1) (List.index Id.equal id2 vars2) +| NVar id1, NVar id2 -> ( + match (get_var_ndx id1 vars1,get_var_ndx id2 vars2) with + | Some n,Some m -> Int.equal n m + | None ,None -> Id.equal id1 id2 + | _ -> false) | NApp (t1, a1), NApp (t2, a2) -> (eq_notation_constr vars) t1 t2 && List.equal (eq_notation_constr vars) a1 a2 | NHole (_, _, _), NHole (_, _, _) -> true (** FIXME? *) diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v index 2ccca829d..b9985a594 100644 --- a/test-suite/output/Notations.v +++ b/test-suite/output/Notations.v @@ -1,3 +1,14 @@ +(* Bug 5568, don't warn for notations in repeated module import *) + +Module foo. +Notation compose := (fun g f => g f). +Notation "g & f" := (compose g f) (at level 10). +End foo. + +Import foo. +Import foo. +Import foo. + (**********************************************************************) (* Notations for if and let (submitted by Roland Zumkeller) *) diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml index 9618cf1b2..628a829e2 100644 --- a/toplevel/metasyntax.ml +++ b/toplevel/metasyntax.ml @@ -1073,11 +1073,11 @@ let open_notation i (_, nobj) = let scope = nobj.notobj_scope in let (ntn, df) = nobj.notobj_notation in let pat = nobj.notobj_interp in - let fresh = not (Notation.exists_notation_in_scope scope ntn pat) in + let onlyprint = nobj.notobj_onlyprint in + let fresh = not (Notation.exists_notation_in_scope scope ntn onlyprint pat) in let active = is_active_compat nobj.notobj_compat in if Int.equal i 1 && fresh && active then begin (* Declare the interpretation *) - let onlyprint = nobj.notobj_onlyprint in let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in (* Declare the uninterpretation *) if not nobj.notobj_onlyparse then -- cgit v1.2.3 From 5ddad92dfc81b0333990dc1956544e924a14600a Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 10 Mar 2017 12:00:35 -0500 Subject: Add tests for handling of warnings --- test-suite/output/RecognizePluginWarning.out | 0 test-suite/output/RecognizePluginWarning.v | 5 +++++ test-suite/output/UsePluginWarning.out | 1 + test-suite/output/UsePluginWarning.v | 7 +++++++ 4 files changed, 13 insertions(+) create mode 100644 test-suite/output/RecognizePluginWarning.out create mode 100644 test-suite/output/RecognizePluginWarning.v create mode 100644 test-suite/output/UsePluginWarning.out create mode 100644 test-suite/output/UsePluginWarning.v (limited to 'test-suite') diff --git a/test-suite/output/RecognizePluginWarning.out b/test-suite/output/RecognizePluginWarning.out new file mode 100644 index 000000000..e69de29bb diff --git a/test-suite/output/RecognizePluginWarning.v b/test-suite/output/RecognizePluginWarning.v new file mode 100644 index 000000000..cd667bbd0 --- /dev/null +++ b/test-suite/output/RecognizePluginWarning.v @@ -0,0 +1,5 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "extraction-logical-axiom") -*- *) + +(* Test that mentioning a warning defined in plugins works. The failure +mode here is that these result in a warning about unknown warnings, since the +plugins are not known at command line parsing time. *) diff --git a/test-suite/output/UsePluginWarning.out b/test-suite/output/UsePluginWarning.out new file mode 100644 index 000000000..47409f3ec --- /dev/null +++ b/test-suite/output/UsePluginWarning.out @@ -0,0 +1 @@ +type foo = __ diff --git a/test-suite/output/UsePluginWarning.v b/test-suite/output/UsePluginWarning.v new file mode 100644 index 000000000..c6e005464 --- /dev/null +++ b/test-suite/output/UsePluginWarning.v @@ -0,0 +1,7 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "-extraction-logical-axiom") -*- *) + +Require Extraction. +Axiom foo : Prop. + +Extraction foo. + -- cgit v1.2.3