diff options
| author |  xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-08-20 12:11:34 +0000 |
|---|---|---|
| committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-08-20 12:11:34 +0000 |
| commit | 6875a7c5fe477d7cc9686ad38b8856edb2d911ad (patch) | |
| tree | e85bde5cace52b28a293a4d9c4e5b3ceedeb2f34 | |
| parent | c58233b2820e6341a8077cf4bf6e3e5b15d1cbf5 (diff) | |
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
| -rw-r--r-- | common/Switch.v | 9 |
1 files 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). |