time 1.2.0.3 → 1.2.0.4

raw patch · 7 files changed

+99/−23 lines, 7 files

Files

• Data/Time/Format.hs +1/−1
• Data/Time/Format/Parse.hs +5/−2
• test/Makefile +5/−6
• test/TestFormat.hs +57/−2
• test/TestParseTime.hs +29/−11
• test/TimeZone.ref +1/−0
• time.cabal +1/−1

@@ -55,7 +55,7 @@ -- -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'): ----- [@%z@] timezone offset on the format @-HHMM@.+-- [@%z@] timezone offset in the format @-HHMM@. -- -- [@%Z@] timezone name --

@@ -179,10 +179,13 @@   where     oneOf = choice . map string     digits n = count n (satisfy isDigit)-    spdigits n = skipSpaces >> upTo n (satisfy isDigit)+    spdigits n = skipSpaces >> oneUpTo n (satisfy isDigit)+    oneUpTo :: Int -> ReadP a -> ReadP [a]+    oneUpTo 0 _ = pfail+    oneUpTo n x = liftM2 (:) x (upTo (n-1) x)     upTo :: Int -> ReadP a -> ReadP [a]     upTo 0 _ = return []-    upTo n x = liftM2 (:) x (upTo (n-1) x) <++ return []+    upTo n x = (oneUpTo n x) <++ return []     numericTZ = do s <- choice [char '+', char '-']                    h <- digits 2                    optional (char ':')

@@ -64,25 +64,27 @@ 	TestFormat.diff0	\ 	TestParseDAT.diff	\ 	TestEaster.diff	\-#	TestParseTime.run \+	TestParseTime.run \ 	UseCases.o+	@echo "Success!"  clean: 	rm -rf TestMonthDay ConvertBack TestCalendars TestTime LongWeekYears ClipDates	\ 	AddDays TestFormat TestParseDAT TestEaster CurrentTime ShowDST TimeZone TimeZone.ref TestParseTime \-        *.out *.o *.hi Makefile.bak+        *.out *.run *.o *.hi Makefile.bak  %.diff: %.ref %.out 	diff -u $^  %.diff0: %.out-	echo -n | diff -u - $^+	diff -u /dev/null $^  %.out: % 	./$< > $@  %.run: % 	./$<+	touch $@  %.hi: %.o 	@:@@ -97,6 +99,3 @@  .SECONDARY: -# TestTime.o TestFormat.o CurrentTime.o ShowDST.o TimeZone.o: $(patsubst %.hs,%.hi,$(SRCS))--TestFixed.o: ../Data/Fixed.hi

@@ -9,6 +9,7 @@ import System.Locale import Foreign import Foreign.C+import Control.Exception;  {- 	size_t format_time (@@ -93,9 +94,63 @@ hashformats :: [String] hashformats =  (fmap (\char -> '%':'#':char:[]) chars) +somestrings :: [String]+somestrings = ["", " ", "-", "\n"] +getBottom :: a -> IO (Maybe Control.Exception.SomeException);+getBottom a = Control.Exception.catch (seq a (return Nothing)) (return . Just);    ++safeString :: String -> IO String+safeString s = do+ msx <- getBottom s+ case msx of+  Just sx -> return (show sx)+  Nothing -> case s of+   (c:cc) -> do+    mcx <- getBottom c+    case mcx of+     Just cx -> return (show cx)+     Nothing -> do+      ss <- safeString cc+      return (c:ss)+   [] -> return ""++compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> Maybe t -> IO ()+compareExpected ts fmt str expected = let+ found = parseTime defaultTimeLocale fmt str+ in do+  mex <- getBottom found+  case mex of+   Just ex -> putStrLn ("Exception with " ++ fmt ++ " for " ++ ts ++" " ++ (show str) ++ ": expected " ++ (show expected) ++ ", caught " ++ (show ex))+   Nothing -> if found == expected+    then return ()+    else do+     sf <- safeString (show found)+     putStrLn ("Mismatch with " ++ fmt ++ " for " ++ ts ++" " ++ (show str) ++ ": expected " ++ (show expected) ++ ", found " ++ sf)++class (ParseTime t) => TestParse t where+    expectedParse :: String -> String -> Maybe t+    expectedParse "%Z" str | all isSpace str = Just (buildTime defaultTimeLocale [])+    expectedParse _ _ = Nothing++instance TestParse Day+instance TestParse TimeOfDay+instance TestParse LocalTime+instance TestParse TimeZone+instance TestParse ZonedTime+instance TestParse UTCTime++checkParse :: String -> String -> IO ()+checkParse fmt str = do+ compareExpected "Day" fmt str (expectedParse fmt str :: Maybe Day)+ compareExpected "TimeOfDay" fmt str (expectedParse fmt str :: Maybe TimeOfDay)+ compareExpected "LocalTime" fmt str (expectedParse fmt str :: Maybe LocalTime)+ compareExpected "TimeZone" fmt str (expectedParse fmt str :: Maybe TimeZone)+ compareExpected "UTCTime" fmt str (expectedParse fmt str :: Maybe UTCTime)+ main :: IO ()-main = -	mapM_ (\fmt -> mapM_ (\time -> mapM_ (\zone -> compareFormat id fmt zone time) zones) times) formats >>+main = do+	mapM_ (\fmt -> mapM_ (checkParse fmt) somestrings) formats+	mapM_ (\fmt -> mapM_ (\time -> mapM_ (\zone -> compareFormat id fmt zone time) zones) times) formats 	mapM_ (\fmt -> mapM_ (\time -> mapM_ (\zone -> compareFormat (fmap toLower) fmt zone time) zones) times) hashformats 

@@ -8,7 +8,9 @@ import Data.Time.Calendar.WeekDate import Data.Time.Clock.POSIX import System.Locale+import System.Exit import Test.QuickCheck+import Test.QuickCheck.Batch   ntest :: Int@@ -16,19 +18,35 @@  main :: IO () main = do putStrLn "Should work:"-          checkAll properties+          good <- checkAll properties           putStrLn "Known failures:"-          checkAll knownFailures+          _ <- checkAll knownFailures+          exitWith (if good then ExitSuccess else ExitFailure 1) -checkAll :: [NamedProperty] -> IO ()-checkAll ps = mapM_ (checkOne config) ps- where config = defaultConfig { configMaxTest = ntest }-       -checkOne :: Config -> NamedProperty -> IO ()-checkOne config (n,p) = -    do putStr (rpad 65 ' ' n)-       check config p-  where rpad n' c xs = xs ++ replicate (n' - length xs) c++checkAll :: [NamedProperty] -> IO Bool+checkAll ps = fmap and (mapM checkOne ps)++trMessage :: TestResult -> String+trMessage (TestOk s _ _) = s+trMessage (TestExausted s i ss) = "Exhausted " ++ (show s) ++ " " ++ (show i) ++ " " ++ (show ss)+trMessage (TestFailed ss i) = "Failed " ++ (show ss) ++ " " ++ (show i)+trMessage (TestAborted ex) = "Aborted " ++ (show ex)++trGood :: TestResult -> Bool+trGood (TestOk _ _ _) = True+trGood _ = False++checkOne :: NamedProperty -> IO Bool+checkOne (n,p) =+    do+       putStr (rpad 65 ' ' n)+       tr <- run p options+       putStrLn (trMessage tr)+       return (trGood tr)+  where+    rpad n' c xs = xs ++ replicate (n' - length xs) c+    options = TestOptions {no_of_tests = 10000,length_of_tests = 0,debug_tests = False}   parse :: ParseTime t => String -> String -> Maybe t

@@ -0,0 +1,1 @@+-0800

@@ -1,5 +1,5 @@ name:           time-version:        1.2.0.3+version:        1.2.0.4 stability:      stable license:        BSD3 license-file:   LICENSE