16c7730 · vty · git.iko.soy

git.iko.soy/vty

add a bit more strictness to the resize generator

commit16c773006a91f0934824aa8f7362f4a36e49f3d8 authorCorey O'Connor <coreyoconnor@gmail.com> dateSat 27 Jul 2013, 14:29 (13 years ago) parent0788d18

4 files changed+46−15

compare with master

unifiedsplit

README.md+9 test/Verify/Graphics/Vty/Image.hs+19−6 test/VerifySpanOps.hs+16−7 test/VerifyTerminfoBased.hs+2−2

README.md+9

@@ -67,3 +67,12 @@ rm -rf dist ; cabal configure --enable-tests --enable-library-coverage \

6767 --disable-library-profiling \

6868 --disable-executable-profiling

6969~~~

70+

71+## Profiling

72+

73+

74+~~~

75+rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \

76+ --enable-library-profiling \

77+ --enable-executable-profiling

78+~~~

test/Verify/Graphics/Vty/Image.hs+19−6

@@ -69,18 +69,23 @@ newtype ImageResize = ImageResize (Image -> (Image, (Int, Int)))

6969

7070instance Arbitrary ImageResize where

7171 arbitrary = oneof

72− [ return $ ImageResize $ \i -> (i, (image_width i, image_height i))

72+ [ return $! ImageResize $! \i -> (i, (image_width i, image_height i))

73+ , return $! ImageResize $! \i -> (i, (image_width i, image_height i))

74+ , return $! ImageResize $! \i -> (i, (image_width i, image_height i))

75+ , return $! ImageResize $! \i -> (i, (image_width i, image_height i))

76+ , return $! ImageResize $! \i -> (i, (image_width i, image_height i))

77+ , return $! ImageResize $! \i -> (i, (image_width i, image_height i))

7378 , do

7479 ImageResize f <- arbitrary

7580 WidthResize g <- arbitrary

76− return $ ImageResize $ \i ->

81+ return $! ImageResize $! \i ->

7782 let (i_0, (_, out_height)) = f i

7883 g_i = g i_0

7984 in (fst g_i, (snd g_i, out_height))

8085 , do

8186 ImageResize f <- arbitrary

8287 HeightResize g <- arbitrary

83− return $ ImageResize $ \i ->

88+ return $! ImageResize $! \i ->

8489 let (i_0, (out_width, _)) = f i

8590 g_i = g i_0

8691 in (fst g_i, (out_width, snd g_i))

@@ -134,18 +139,26 @@ instance Arbitrary Image where

134139 [ do

135140 SingleAttrSingleSpanStack {stack_image} <- arbitrary

136141 ImageResize f <- arbitrary

137− return $ fst $ f stack_image

142+ return $! fst $! f stack_image

143+ , do

144+ SingleAttrSingleSpanStack {stack_image} <- arbitrary

145+ ImageResize f <- arbitrary

146+ return $! fst $! f stack_image

147+ , do

148+ SingleAttrSingleSpanStack {stack_image} <- arbitrary

149+ ImageResize f <- arbitrary

150+ return $! fst $! f stack_image

138151 , do

139152 i_0 <- arbitrary

140153 i_1 <- arbitrary

141154 let i = i_0 <|> i_1

142155 ImageResize f <- arbitrary

143− return $ fst $ f i

156+ return $! fst $! f i

144157 , do

145158 i_0 <- arbitrary

146159 i_1 <- arbitrary

147160 let i = i_0 <-> i_1

148161 ImageResize f <- arbitrary

149− return $ fst $ f i

162+ return $! fst $! f i

150163 ]

151164

test/VerifySpanOps.hs+16−7

@@ -149,6 +149,13 @@ single_attr_single_span_stack_op_coverage stack =

149149 spans = spans_for_pic p (region_for_window w)

150150 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)

151151

152+image_coverage_matches_bounds :: Image -> Result

153+image_coverage_matches_bounds i =

154+ let p = pic_for_image i

155+ r = DisplayRegion (image_width i) (image_height i)

156+ spans = spans_for_pic p r

157+ in verify_all_spans_have_width i spans (image_width i)

158+

152159tests :: IO [Test]

153160tests = return

154161 [ verify "unit image is cropped when window size == (0,0) [0]" unit_image_and_zero_window_0

@@ -164,18 +171,20 @@ tests = return

164171 , verify "The span ops actually define content for all the columns in the output region" span_ops_actually_fill_columns

165172 , verify "first span op is always to set the text attribute" first_span_op_sets_attr

166173 , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"

167− single_attr_single_span_stack_op_coverage

174+ single_attr_single_span_stack_op_coverage

168175 , verify "a single attr text span is cropped when window size < size of stack image [width]"

169− single_attr_single_span_stack_cropped_0

176+ single_attr_single_span_stack_cropped_0

170177 , verify "a single attr text span is cropped when window size < size of stack image [height]"

171− single_attr_single_span_stack_cropped_1

178+ single_attr_single_span_stack_cropped_1

172179 , verify "single attr text span <|> single attr text span cropped. [width]"

173− single_attr_single_span_stack_cropped_2

180+ single_attr_single_span_stack_cropped_2

174181 , verify "single attr text span <|> single attr text span cropped. [height]"

175− single_attr_single_span_stack_cropped_3

182+ single_attr_single_span_stack_cropped_3

176183 , verify "single attr text span <-> single attr text span cropped. [width]"

177− single_attr_single_span_stack_cropped_4

184+ single_attr_single_span_stack_cropped_4

178185 , verify "single attr text span <-> single attr text span cropped. [height]"

179− single_attr_single_span_stack_cropped_5

186+ single_attr_single_span_stack_cropped_5

187+ , verify "an arbitrary image when rendered to a window of the same size will cover the entire window"

188+ image_coverage_matches_bounds

180189 ]

181190

test/VerifyTerminfoBased.hs+2−2

@@ -27,8 +27,8 @@ tests = concat <$> forM terminals_of_interest (\term_name -> do

2727 ]

2828 )

2929

30−smoke_test_term :: String -> SingleAttrSingleSpanStack -> Property

31−smoke_test_term term_name (SingleAttrSingleSpanStack i _ _ _) = liftIOResult $ do

30+smoke_test_term :: String -> Image -> Property

31+smoke_test_term term_name i = liftIOResult $ do

3232 null_out <- openFile "/dev/null" WriteMode

3333 t <- TerminfoBased.reserve_terminal term_name null_out

3434 putStrLn $ "context color count: " ++ show (context_color_count t)