From 6875a7c5fe477d7cc9686ad38b8856edb2d911ad Mon Sep 17 00:00:00 2001 From: xleroy Date: Wed, 20 Aug 2014 12:11:34 +0000 Subject: Excessively strict validation: ofs + sz < modulus should have been ofs + sz <= modulus. git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2607 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- common/Switch.v | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/common/Switch.v b/common/Switch.v index 4723f50..e5b3827 100644 --- a/common/Switch.v +++ b/common/Switch.v @@ -157,8 +157,9 @@ Fixpoint validate (default: nat) (cases: table) (t: comptree) end | CTjumptable ofs sz tbl t' => let tbl_len := list_length_z tbl in - zle 0 ofs && zle 0 sz && zlt (ofs + sz) modulus && - zle sz tbl_len && zlt sz Int.modulus && + zle 0 ofs && zlt ofs modulus && + zle 0 sz && zlt sz modulus && + zle (ofs + sz) modulus && zle sz tbl_len && zlt sz Int.modulus && match split_between default ofs sz cases with | (inside, outside) => validate_jumptable inside tbl ofs @@ -195,7 +196,7 @@ Proof. - destruct (split_lt key cases) as [lc rc]; InvBooleans. constructor; eauto. - destruct (split_between default ofs sz cases) as [ins out]; InvBooleans. - constructor; eauto; omega. + constructor; eauto. Qed. (** Semantic correctness proof for validation. *) @@ -280,7 +281,7 @@ Lemma validate_jumptable_correct: forall cases tbl ofs v sz, validate_jumptable cases tbl ofs = true -> (v - ofs) mod modulus < sz -> - 0 <= sz -> 0 <= ofs -> ofs + sz < modulus -> + 0 <= sz -> 0 <= ofs -> ofs + sz <= modulus -> 0 <= v < modulus -> sz <= list_length_z tbl -> list_nth_z tbl ((v - ofs) mod modulus) = Some(ZMap.get v cases). -- cgit v1.2.3