Diff
patch b647f1acad0f97446fc00e08590f747c69fb0768
Author: fritjof@alokat.org
Date: Wed Apr 22 06:28:51 UTC 2026
* Add Properties.Config test module (missed in previous patch)
addfile ./test/Properties/Config.hs
hunk ./test/Properties/Config.hs 1
+{-# LANGUAGE OverloadedStrings #-}
+
+module Properties.Config (tests) where
+
+import Test.QuickCheck
+
+import DarcsWeb.Config (parsePortPure)
+
+-- --------------------------------------------------------------------------
+-- parsePortPure: pin the accepted/rejected port-value set so a future
+-- refactor of the startup parser cannot silently widen or narrow it.
+-- --------------------------------------------------------------------------
+
+prop_port_accepts_valid :: Property
+prop_port_accepts_valid =
+ forAll (choose (1, 65535)) $ \p ->
+ parsePortPure (show p) == Just (p :: Int)
+
+prop_port_rejects_zero :: Bool
+prop_port_rejects_zero = parsePortPure "0" == Nothing
+
+prop_port_rejects_negative :: Property
+prop_port_rejects_negative =
+ forAll (choose (minBound :: Int, -1)) $ \p ->
+ parsePortPure (show p) == Nothing
+
+prop_port_rejects_over_max :: Property
+prop_port_rejects_over_max =
+ forAll (choose (65536, maxBound :: Int)) $ \p ->
+ parsePortPure (show p) == Nothing
+
+prop_port_rejects_non_numeric :: Bool
+prop_port_rejects_non_numeric = and
+ [ parsePortPure "" == Nothing
+ , parsePortPure " " == Nothing
+ , parsePortPure "abc" == Nothing
+ , parsePortPure "80a" == Nothing
+ , parsePortPure "8080 " == Nothing -- trailing space
+ , parsePortPure " 8080" == Nothing -- leading space
+ , parsePortPure "8080#" == Nothing -- trailing comment
+ , parsePortPure "0x50" == Nothing -- hex not accepted
+ ]
+
+-- --------------------------------------------------------------------------
+-- Test runner
+-- --------------------------------------------------------------------------
+
+tests :: IO Bool
+tests = fmap and $ sequence
+ [ run "port accepts 1..65535" (property prop_port_accepts_valid)
+ , run "port rejects 0" (property prop_port_rejects_zero)
+ , run "port rejects negative" (property prop_port_rejects_negative)
+ , run "port rejects over-max" (property prop_port_rejects_over_max)
+ , run "port rejects non-numeric" (property prop_port_rejects_non_numeric)
+ ]
+ where
+ run name prop = do
+ putStr $ " " ++ name ++ ": "
+ r <- quickCheckWithResult stdArgs { maxSuccess = 200 } prop
+ return (isSuccess r)
