netpbm-1.0.0: test/Main.hs
{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.Vector.Storable as S
import Foreign.Ptr (castPtr)
import Foreign.Marshal.Utils (copyBytes)
import Test.Hspec
import Test.HUnit
import Graphics.Netpbm
checkSinglePPM :: PPMType -> (Int, Int) -> PpmParseResult -> Assertion
checkSinglePPM typ size parseResult = case parseResult of
Right ([PPM { ppmHeader = PPMHeader { ppmType, ppmWidth, ppmHeight } }], rest) -> (ppmType, (ppmWidth, ppmHeight), rest) `shouldBe` (typ, size, Nothing)
Right (ppms, _) -> assertFailure $ "expected only one image, but got " ++ show (length ppms)
Left e -> assertFailure $ "image parse failed: " ++ e
checkSinglePPMdata :: PPMType -> (Int, Int) -> [Int] -> PpmParseResult -> Assertion
checkSinglePPMdata typ size expected parseResult = case parseResult of
Right ([PPM { ppmHeader = PPMHeader { ppmType, ppmWidth, ppmHeight }
, ppmData }], rest) -> do
(ppmType, (ppmWidth, ppmHeight), rest) `shouldBe` (typ, size, Nothing)
pixelDataToIntList ppmData `shouldBe` expected
Right (ppms, _) -> assertFailure $ "expected only one image, but got " ++ show (length ppms)
Left e -> assertFailure $ "image parse failed: " ++ e
shouldNotParse :: PpmParseResult -> Assertion
shouldNotParse res = case res of
Left _ -> return ()
Right r -> assertFailure $ "should not parse, but parses as: " ++ show r
parse :: FilePath -> IO PpmParseResult
parse f = parsePPM <$> BS.readFile f
parseTestFile :: String -> String -> (PpmParseResult -> Assertion) -> Spec
parseTestFile name desc check = it (desc ++ " (" ++ name ++ ")") $
parse ("test/ppms/" ++ name) >>= check
repcat :: Int -> [a] -> [a]
repcat n = concat . replicate n
-- @dir@ must have trailing slash.
checkDirectory :: FilePath -> String -> PPMType -> [(String, (Int, Int))] -> Spec
checkDirectory dir desc typ filesWithSizes = forM_ filesWithSizes $ \(f, size) ->
parseTestFile (dir ++ f) desc $ checkSinglePPM typ size
main :: IO ()
main = hspec $ do
describe "P6 PPM (color binary)" $ do
parseTestFile "gimp.ppm" "a file produced by GIMP" $
checkSinglePPM P6 (640,400)
parseTestFile "gitlogo.ppm" "a file produced by convert" $
checkSinglePPM P6 (220,92)
parseTestFile "image.ppm" "some random file from the internet" $
checkSinglePPM P6 (1200,1200)
parseTestFile "testimg.ppm" "the color file from the netpbm test suite" $
checkSinglePPM P6 (227,149)
describe "more test files from the internet" $ do
checkDirectory "internet/set1/" "from the internet" P6
[ ("boxes_1.ppm", (63,63))
, ("boxes_2.ppm", (63,63))
, ("house_1.ppm", (111,132))
, ("house_2.ppm", (111,132))
, ("moreboxes_1.ppm", (63,63))
, ("moreboxes_2.ppm", (63,63))
, ("sign_1.ppm", (99,99))
, ("sign_2.ppm", (99,99))
, ("stop_1.ppm", (99,99))
, ("stop_2.ppm", (99,99))
, ("synth_1.ppm", (100,100))
, ("synth_2.ppm", (100,100))
, ("tree_1.ppm", (133,133))
, ("tree_2.ppm", (133,133))
, ("west_1.ppm", (366,216))
, ("west_2.ppm", (366,216))
]
checkDirectory "internet/set3/" "from the internet, PNM" P6
[ ("birch.pnm", (128,128))
, ("cotton.pnm", (256,170))
, ("oak.pnm", (128,128))
, ("quilt.pnm", (256,237))
]
parseTestFile "internet/set2/mandrill.ppm" "the color file from the 'Math 625' course" $
checkSinglePPM P6 (512,512)
parseTestFile "internet/set2/half.ppm" "the color file from the 'Math 625' course, half width" $
checkSinglePPM P6 (256,512)
parseTestFile "SIPI.ppm" "SIPI test file" $
-- convert SIPI.tiff SIPI.ppm
checkSinglePPM P6 (256,256)
parseTestFile "gitlogo-double.ppm" "a multi-image file" $ do
\res -> case res of
Right ([ PPM { ppmHeader = h1 }
, PPM { ppmHeader = h2 }], rest) -> do h1 `shouldBe` PPMHeader P6 220 92
h2 `shouldBe` PPMHeader P6 220 92
rest `shouldBe` Nothing
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
describe "comments" $ do
parseTestFile "gitlogo-comments.ppm" "comments as a sane user would write them" $
checkSinglePPM P6 (220,92)
parseTestFile "gitlogo-comment-after-magic-number.ppm" "a comment directly after the P6" $
checkSinglePPM P6 (220,92)
parseTestFile "gitlogo-only-spaces-in-header.ppm" "only spaces as header separators" $
checkSinglePPM P6 (220,92)
parseTestFile "gitlogo-comment-is-data.ppm" "the user thinks they wrote a comment, but it's actually parsed as data" $
\res -> case res of
Right ([PPM { ppmHeader }], Just rest) -> do ppmHeader `shouldBe` PPMHeader P6 220 92
rest `shouldBe` "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\n"
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
describe "weird files that are still OK with the spec" $ do
parseTestFile "weird/gitlogo-width-0.ppm" "width '00' set in an image" $
\res -> case res of
Right ([PPM { ppmHeader }], Just rest) -> do ppmHeader `shouldBe` PPMHeader P6 220 0
assertBool "missing rest" (BS.length rest > 200)
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
parseTestFile "weird/gitlogo-comments-everywhere.ppm" "comments inside numbers" $
checkSinglePPM P6 (220,92)
describe "partially valid files of which we parse as much as we can" $ do
parseTestFile "graceful/face.ppm" "a PPM with a trailing newline" $
checkSinglePPM P6 (512,512)
parseTestFile "graceful/gitlogo-one-and-a-half.ppm" "a multi-image file where the second image is chopped off" $
\res -> case res of
Right ([PPM { ppmHeader }], Just rest) -> do ppmHeader `shouldBe` PPMHeader P6 220 92
assertBool "missing rest" (BS.length rest > 200)
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
parseTestFile "graceful/gitlogo-double-with-whitespace-in-between.ppm" "a multi-image file with whitespace between the images" $
\res -> case res of
Right ([ PPM { ppmHeader = h1 }
, PPM { ppmHeader = h2 }], rest) -> do h1 `shouldBe` PPMHeader P6 220 92
h2 `shouldBe` PPMHeader P6 220 92
rest `shouldBe` Nothing
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
describe "16-bit images" $ do
-- See http://wiki.simg.de/doku.php?id=common:formats#pnm_family
parseTestFile "gitlogo-16bit-created-by-simg_convert_-16be_gitlogo.ppm_output.ppm" "16-bit image created by simg" $
\res -> case res of
Right ([PPM { ppmHeader, ppmData }], rest) -> do ppmHeader `shouldBe` PPMHeader P6 220 92
rest `shouldBe` Nothing
case ppmData of
PpmPixelDataRGB16 _ -> return ()
_ -> assertFailure $ "did not get 16-bit data"
Right r -> assertFailure $ "parsed unexpected: " ++ show r
Left e -> assertFailure $ "did not parse: " ++ e
parseTestFile "SIPI-16.ppm" "SIPI test file" $
-- convert SIPI.tiff -depth 16 SIPI-16.ppm
checkSinglePPM P6 (256,256)
-- TODO try to get a 16-bit image out of the new gimp
describe "negative examples" $ do
parseTestFile "bad/gitlogo-garbage-in-numbers.ppm" "ascii characters in a number" shouldNotParse
parseTestFile "bad/gitlogo-width--1.ppm" "width '-1' set in an image" shouldNotParse
parseTestFile "bad/gitlogo-not-enough-data.ppm" "not containing (width * height) bytes" shouldNotParse
parseTestFile "bad/gitlogo-comment-in-magic-number.ppm" "comment inside magic number" shouldNotParse
parseTestFile "bad/gitlogo-comment-user-error.ppm" "a comment accidentally being put to close to a number, eating the following whitespace" $ shouldNotParse
parseTestFile "bad/gitlogo-comment-user-error-no-space-after-magic.ppm" "a comment accidentally being put to close to the magic number, eating the following whitespace" $ shouldNotParse
parseTestFile "bad/gitlogo-comment-without-following-extra-newline-before-data-block.ppm" "no non-comment whitespace before data block" shouldNotParse
parseTestFile "bad/gitlogo-value-bigger-than-maxval.ppm" "subpixel value is bigger than maxval" shouldNotParse
parseTestFile "internet/set3/cathedral.pnm" "subpixel value is bigger than maxval" shouldNotParse
parseTestFile "internet/set3/checkers.pnm" "subpixel value is bigger than maxval" shouldNotParse
parseTestFile "internet/set3/fish_tile.pnm" "subpixel value is bigger than maxval" shouldNotParse
parseTestFile "internet/set3/garnet.pnm" "subpixel value is bigger than maxval" shouldNotParse
describe "P5 PGM (greyscale binary)" $ do
parseTestFile "internet/set2/mandrill.pgm" "the color file from the 'Math 625' course" $
checkSinglePPM P5 (512,512)
parseTestFile "internet/set2/half.pgm" "the color file from the 'Math 625' course, half width" $
checkSinglePPM P5 (256,512)
parseTestFile "SIPI-convert.pgm" "a file produced by convert" $
-- convert SIPI.tiff SIPI-convert.pgm
checkSinglePPM P5 (256,256)
describe "comments" $ do
parseTestFile "internet/set2/comments.pgm" "the color file from the 'Math 625' course, with comments" $
checkSinglePPM P5 (512,512)
describe "16-bit" $ do
parseTestFile "SIPI-convert-16.pgm" "a file produced by convert, 16-bit" $
-- convert SIPI.tiff -depth 16 SIPI-convert-16.pgm
checkSinglePPM P5 (256,256)
describe "P4 PBM (bitmap binary)" $ do
parseTestFile "testgrid.pbm" "the bitmap file from the netpbm test suite" $
checkSinglePPMdata P4 (14,16) (repcat 8 (repcat 7 [0,1] ++ replicate 14 0))
parseTestFile "SIPI-convert.pbm" "a file produced by convert" $
-- convert SIPI.tiff SIPI-convert.pbm
checkSinglePPM P4 (256,256)
describe "P3 PPM (color ASCII)" $ do
checkDirectory "internet/set3/" "more test files from the internet" P3
[ ("feep.ppm", (4,4))
, ("snail.ppm", (256,256))
]
parseTestFile "SIPI-convert-plain.ppm" "a file produced by convert" $
-- convert SIPI.tiff -compress none SIPI-convert-plain.ppm
checkSinglePPM P3 (256,256)
parseTestFile "SIPI-convert-plain-16.ppm" "a file produced by convert, 16-bit" $
-- convert SIPI.tiff -compress none -depth 16 SIPI-convert-plain-16.ppm
checkSinglePPM P3 (256,256)
describe "P2 PGM (greyscale ASCII)" $ do
checkDirectory "internet/set3/" "more test files from the internet" P2
[ ("balloons.pgm", (640,480))
, ("columns.pgm", (640,480))
, ("feep.pgm", (24,7))
, ("tracks.pgm", (300,200))
]
parseTestFile "pgm-plain-made-up-from-pbm-spec.pgm" "the plain PBM file from the spec example, converted to PGM" $
-- Invert 0/1 because in PBM 1 is black, not so in PGM
checkSinglePPMdata P2 (24,7) (map (1 -) pbmFromSpecResult)
parseTestFile "SIPI-convert-plain.pgm" "a file produced by convert" $
-- convert SIPI.tiff -compress none SIPI-convert-plain.pgm
checkSinglePPM P2 (256,256)
describe "16-bit" $ do
parseTestFile "SIPI-convert-plain-16.pgm" "a file produced by convert, 16-bit" $
-- convert SIPI.tiff -compress none -depth 16 SIPI-convert-plain-16.pgm
checkSinglePPM P2 (256,256)
describe "P1 PBM (bitmap ASCII)" $ do
describe "more test files from the internet" $ do
checkDirectory "internet/set3/" "from the internet" P1
[ ("circle_ascii.pbm", (200,200))
, ("feep.pbm", (24,7))
]
parseTestFile "pbm-plain-from-spec.pbm" "the plain PBM file from the spec example" $
checkSinglePPMdata P1 (24,7) pbmFromSpecResult
describe "ASCII files should only contain one image" $ do
parseTestFile "pbm-plain-from-spec-multiple-but-treated-as-junk.pbm" "ASCII PBM from spec, multiple times, rest should be treated as junk" $
checkSinglePPMdata P1 (24,7) pbmFromSpecResult
parseTestFile "bad/pbm-plain-from-spec-multiple-no-space-before-junk.pbm" "ASCII PBM from spec, multiple times, rest should be treated as junk" $
shouldNotParse
parseTestFile "SIPI-convert-plain.pbm" "a file produced by convert" $
-- convert SIPI.tiff -compress none SIPI-convert-plain.pbm
checkSinglePPM P1 (256,256)
describe "In-memory format" $ do
it "represents 8-bit images in rgbrgbrgb... format" $ do
let d = PpmPixelDataRGB8 $ S.fromList [ PpmPixelRGB8 1 2 3
, PpmPixelRGB8 4 5 6
, PpmPixelRGB8 7 8 9 ]
let PpmPixelDataRGB8 vec = d
bs <- BSI.create 9 $ \bsPtrWord8 ->
S.unsafeWith vec $ \ppmPixelRgb8Ptr ->
copyBytes bsPtrWord8 (castPtr ppmPixelRgb8Ptr) 9
bs `shouldBe` "\1\2\3\4\5\6\7\8\9"
-- Some result data
-- Note that in a PBM file, "1" means black, but in the result 0 means black.
pbmFromSpecResult :: [Int]
pbmFromSpecResult = [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1
,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,0,1
,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,0,1
,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1
,1,0,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,1,1,1,1
,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]