/usr/lib/hugs/oldlib/TestOrdBag.hs is in hugs 98.200609.21-5.4+b3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | -- Copyright (c) 1999 Chris Okasaki.
-- See COPYRIGHT file for terms and conditions.
module TestOrdBag
{-# DEPRECATED "This module is unmaintained, and will disappear soon" #-}
where
import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1,
filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
import qualified Prelude
import EdisonPrelude(Maybe2(Just2,Nothing2))
import qualified Collection as C
import qualified List -- not ListSeq!
import qualified ListSeq as L
import QuickCheck
import LazyPairingHeap -- the bag module being tested
import qualified JoinList as S -- the sequence module being tested
-- To different modules, simply replace the names above.
-- To test a bag module that does not name its type constructor "Bag",
-- you also need to define a type synonym
-- type Bag a = ...
-- You may also need to adjust the Seq type synonym.
type Bag a = Heap a
type Seq a = S.Seq a
tol :: Bag Int -> [Int]
tol = C.toOrdList
lmerge :: [Int] -> [Int] -> [Int]
lmerge xs [] = xs
lmerge [] ys = ys
lmerge xs@(x:xs') ys@(y:ys')
| x <= y = x : lmerge xs' ys
| otherwise = y : lmerge xs ys'
-- CollX operations
prop_single :: Int -> Bool
prop_single x =
tol (single x) == [x]
prop_fromSeq :: Seq Int -> Bool
prop_fromSeq xs =
fromSeq xs == S.foldr insert empty xs
prop_insert :: Int -> Bag Int -> Bool
prop_insert x xs =
tol (insert x xs) == List.insert x (tol xs)
prop_insertSeq :: Seq Int -> Bag Int -> Bool
prop_insertSeq xs ys =
insertSeq xs ys == union (fromSeq xs) ys
prop_union :: Bag Int -> Bag Int -> Bool
prop_union xs ys =
tol (union xs ys) == lmerge (tol xs) (tol ys)
prop_unionSeq :: Seq (Bag Int) -> Bool
prop_unionSeq xss =
unionSeq xss == S.foldr union empty xss
prop_delete :: Int -> Bag Int -> Bool
prop_delete x xs =
tol (delete x xs) == List.delete x (tol xs)
prop_deleteAll :: Int -> Bag Int -> Bool
prop_deleteAll x xs =
tol (deleteAll x xs) == Prelude.filter (/= x) (tol xs)
prop_deleteSeq :: Seq Int -> Bag Int -> Bool
prop_deleteSeq xs ys =
deleteSeq xs ys == S.foldr delete ys xs
prop_null_size :: Bag Int -> Bool
prop_null_size xs =
null xs == (size xs == 0)
&&
size xs == Prelude.length (tol xs)
prop_member_count :: Bag Int -> Int -> Bool
prop_member_count xs x =
member xs x == (c > 0)
&&
c == Prelude.length (Prelude.filter (== x) (tol xs))
where c = count xs x
-- Coll operations
prop_toSeq :: Bag Int -> Bool
prop_toSeq xs =
List.sort (S.toList (toSeq xs)) == tol xs
prop_lookup :: Bag Int -> Int -> Bool
prop_lookup xs x =
if member xs x then
lookup xs x == x
&&
lookupM xs x == Just x
&&
lookupWithDefault 999 xs x == x
&&
lookupAll xs x == Prelude.take (count xs x) (repeat x)
else
lookupM xs x == Nothing
&&
lookupWithDefault 999 xs x == 999
&&
lookupAll xs x == []
prop_fold :: Bag Int -> Bool
prop_fold xs =
List.sort (fold (:) [] xs) == tol xs
&&
(null xs || fold1 (+) xs == sum (tol xs))
prop_filter_partition :: Bag Int -> Bool
prop_filter_partition xs =
tol (filter p xs) == Prelude.filter p (tol xs)
&&
partition p xs == (filter p xs, filter (not . p) xs)
where p x = x `mod` 3 == 2
-- OrdCollX operations
prop_deleteMin_Max :: Bag Int -> Bool
prop_deleteMin_Max xs =
tol (deleteMin xs) == L.ltail (tol xs)
&&
tol (deleteMax xs) == L.rtail (tol xs)
prop_unsafeInsertMin_Max :: Int -> Bag Int -> Bool
prop_unsafeInsertMin_Max i xs =
if null xs then
unsafeInsertMin 0 xs == single 0
&&
unsafeInsertMax xs 0 == single 0
else
unsafeInsertMin lo xs == insert lo xs
&&
unsafeInsertMax xs hi == insert hi xs
where lo = minElem xs - (if odd i then 1 else 0)
hi = maxElem xs + (if odd i then 1 else 0)
prop_unsafeFromOrdSeq :: [Int] -> Bool
prop_unsafeFromOrdSeq xs =
tol (unsafeFromOrdSeq xs') == xs'
where xs' = List.sort xs
prop_unsafeAppend :: Int -> Bag Int -> Bag Int -> Bool
prop_unsafeAppend i xs ys =
if null xs || null ys then
unsafeAppend xs ys == union xs ys
else
unsafeAppend xs ys' == union xs ys'
where delta = maxElem xs - minElem ys + (if odd i then 1 else 0)
ys' = unsafeMapMonotonic (+delta) ys
-- if unsafeMapMonotonic does any reorganizing in addition
-- to simply replacing the elements, then this test will
-- not provide even coverage
prop_filter :: Int -> Bag Int -> Bool
prop_filter x xs =
tol (filterLT x xs) == Prelude.filter (< x) (tol xs)
&&
tol (filterLE x xs) == Prelude.filter (<= x) (tol xs)
&&
tol (filterGT x xs) == Prelude.filter (> x) (tol xs)
&&
tol (filterGE x xs) == Prelude.filter (>= x) (tol xs)
prop_partition :: Int -> Bag Int -> Bool
prop_partition x xs =
partitionLT_GE x xs == (filterLT x xs, filterGE x xs)
&&
partitionLE_GT x xs == (filterLE x xs, filterGT x xs)
&&
partitionLT_GT x xs == (filterLT x xs, filterGT x xs)
-- OrdColl operations
prop_minView_maxView :: Bag Int -> Bool
prop_minView_maxView xs =
minView xs == (if null xs then Nothing2
else Just2 (minElem xs) (deleteMin xs))
&&
maxView xs == (if null xs then Nothing2
else Just2 (deleteMax xs) (maxElem xs))
prop_minElem_maxElem :: Bag Int -> Property
prop_minElem_maxElem xs =
not (null xs) ==>
minElem xs == Prelude.head (tol xs)
&&
maxElem xs == Prelude.last (tol xs)
prop_foldr_foldl :: Bag Int -> Bool
prop_foldr_foldl xs =
foldr (:) [] xs == tol xs
&&
foldl (flip (:)) [] xs == Prelude.reverse (tol xs)
prop_foldr1_foldl1 :: Bag Int -> Property
prop_foldr1_foldl1 xs =
not (null xs) ==>
foldr1 f xs == foldr f 1333 xs
&&
foldl1 (flip f) xs == foldl (flip f) 1333 xs
where f x 1333 = x
f x y = 3*x - 7*y
prop_toOrdSeq :: Bag Int -> Bool
prop_toOrdSeq xs =
S.toList (toOrdSeq xs) == tol xs
-- bonus operation, not supported by all ordered collections
prop_unsafeMapMonotonic :: Bag Int -> Bool
prop_unsafeMapMonotonic xs =
tol (unsafeMapMonotonic (2*) xs) == Prelude.map (2*) (tol xs)
|