[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: more TestInstance clean-up (0417890)

Fri Apr 21 16:51:35 UTC 2017

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/041789051b0d6aa09d03560bf0b5b3c7fda9c645

>---------------------------------------------------------------

commit 041789051b0d6aa09d03560bf0b5b3c7fda9c645
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sun Oct 28 22:28:49 2012 -0700

    more TestInstance clean-up
    
    Ignore-this: 2596abdead9de1796655be9e58f2ce95
    
    darcs-hash:20121029052849-ac6dd-ebd63fbd2dd9044bcd2ec8f5c5073c5514eac0f5


>---------------------------------------------------------------

041789051b0d6aa09d03560bf0b5b3c7fda9c645
 Test/AddDays.hs       |  2 +-
 Test/ClipDates.hs     |  2 +-
 Test/ConvertBack.hs   |  2 +-
 Test/LongWeekYears.hs |  2 +-
 Test/TestCalendars.hs |  2 +-
 Test/TestEaster.hs    |  2 +-
 Test/TestFormat.hs    |  4 ++--
 Test/TestMonthDay.hs  |  2 +-
 Test/TestParseDAT.hs  |  2 +-
 Test/TestTime.hs      |  2 +-
 Test/TestUtil.hs      | 38 +++++++++++++++++---------------------
 11 files changed, 28 insertions(+), 32 deletions(-)

diff --git a/Test/AddDays.hs b/Test/AddDays.hs
index a3754d9..0066673 100644
--- a/Test/AddDays.hs
+++ b/Test/AddDays.hs
@@ -43,5 +43,5 @@ resultDays = do
 
 addDaysTest :: Test
 addDaysTest
-  = Test $ pure $ SimpleTest "addDays"
+  = Test $ pure "addDays"
       $ diff addDaysRef $ unlines resultDays
diff --git a/Test/ClipDates.hs b/Test/ClipDates.hs
index 1b5d35f..761b9e9 100644
--- a/Test/ClipDates.hs
+++ b/Test/ClipDates.hs
@@ -35,7 +35,7 @@ tupleUp3 l1 l2 l3
 
 clipDates :: Test
 clipDates
-  = Test $ pure $ SimpleTest "clipDates"
+  = Test $ pure "clipDates"
       $ let yad  = unlines $ map yearAndDay
                    $ tupleUp2 [1968,1969,1971] [-4,0,1,200,364,365,366,367,700]
                               
diff --git a/Test/ConvertBack.hs b/Test/ConvertBack.hs
index ce0238b..857e80f 100644
--- a/Test/ConvertBack.hs
+++ b/Test/ConvertBack.hs
@@ -42,5 +42,5 @@ days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++
 
 convertBack :: Test
 convertBack
-  = Test $ pure $ SimpleTest "convertBack"
+  = Test $ pure "convertBack"
       $ diff "" $ concatMap (\ch -> concatMap ch days) checkers
diff --git a/Test/LongWeekYears.hs b/Test/LongWeekYears.hs
index 7824425..220b3c7 100644
--- a/Test/LongWeekYears.hs
+++ b/Test/LongWeekYears.hs
@@ -22,5 +22,5 @@ showLongYear year
 
 longWeekYears :: Test
 longWeekYears
-  = Test $ pure $ SimpleTest "longWeekYears"
+  = Test $ pure "longWeekYears"
       $ diff longWeekYearsRef $ unlines $ map showLongYear [1901 .. 2050]
diff --git a/Test/TestCalendars.hs b/Test/TestCalendars.hs
index 324b792..5f1932c 100644
--- a/Test/TestCalendars.hs
+++ b/Test/TestCalendars.hs
@@ -29,7 +29,7 @@ days = [
 
 testCalendars :: Test
 testCalendars 
-  = Test $ pure $ SimpleTest "testCalendars"
+  = Test $ pure "testCalendars"
       $ diff testCalendarsRef 
           $ unlines $ map (\d -> showShowers d) days
  where
diff --git a/Test/TestEaster.hs b/Test/TestEaster.hs
index b6b9bd7..e97c84e 100644
--- a/Test/TestEaster.hs
+++ b/Test/TestEaster.hs
@@ -21,7 +21,7 @@ showWithWDay = formatTime defaultTimeLocale "%F %A"
 
 testEaster :: Test
 testEaster 
-  = Test $ pure $ SimpleTest "testEaster"
+  = Test $ pure "testEaster"
       $ let ds = unlines $ map (\day ->
                    unwords [ showWithWDay day, "->"
                            , showWithWDay (sundayAfter day)]) days
diff --git a/Test/TestFormat.hs b/Test/TestFormat.hs
index eb8b2ee..001de68 100644
--- a/Test/TestFormat.hs
+++ b/Test/TestFormat.hs
@@ -75,7 +75,7 @@ times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++
 compareFormat :: String -> (String -> String) -> String -> TimeZone -> UTCTime -> TestInstance
 compareFormat testname modUnix fmt zone time =
   let ctime = utcToZonedTime zone time in
-  impure $ IO_SimpleTest (testname ++ ": " ++ (show fmt) ++ " of " ++ (show ctime)) $
+  impure (testname ++ ": " ++ (show fmt) ++ " of " ++ (show ctime)) $
     do
       let haskellText = formatTime locale fmt ctime
       unixText <- fmap modUnix (unixFormatTime fmt zone time)
@@ -124,7 +124,7 @@ safeString s = do
    [] -> return ""
 
 compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> Maybe t -> TestInstance
-compareExpected testname fmt str expected = impure $ IO_SimpleTest (testname ++ ": " ++ (show fmt) ++ " on " ++ (show str)) $ do
+compareExpected testname fmt str expected = impure (testname ++ ": " ++ (show fmt) ++ " on " ++ (show str)) $ do
     let found = parseTime defaultTimeLocale fmt str
     mex <- getBottom found
     case mex of
diff --git a/Test/TestMonthDay.hs b/Test/TestMonthDay.hs
index 0d3a665..fa3bdcc 100644
--- a/Test/TestMonthDay.hs
+++ b/Test/TestMonthDay.hs
@@ -15,7 +15,7 @@ showCompare a1 b a2 = "DIFF: " ++ (show a1) ++ " -> " ++ b ++ " -> " ++ (show a2
 
 testMonthDay :: Test
 testMonthDay
-  = Test $ pure $ SimpleTest "testMonthDay"
+  = Test $ pure "testMonthDay"
       $ diff testMonthDayRef 
             $ concat $ map (\isL -> unlines (leap isL : yearDays isL)) [False,True]
  where
diff --git a/Test/TestParseDAT.hs b/Test/TestParseDAT.hs
index 187d062..313758d 100644
--- a/Test/TestParseDAT.hs
+++ b/Test/TestParseDAT.hs
@@ -43,7 +43,7 @@ times =
 
 testParseDAT :: Test
 testParseDAT
-  = Test $ pure $ SimpleTest "testParseDAT"
+  = Test $ pure "testParseDAT"
       $ diff testParseDAT_Ref parseDAT
  where
   parseDAT =
diff --git a/Test/TestTime.hs b/Test/TestTime.hs
index c47712e..cfa476b 100644
--- a/Test/TestTime.hs
+++ b/Test/TestTime.hs
@@ -108,5 +108,5 @@ testTimeOfDayToDayFraction
 
 testTime :: Test
 testTime
-  = Test $ pure $ SimpleTest "testTime"
+  = Test $ pure "testTime"
       $ diff testTimeRef $ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction]
diff --git a/Test/TestUtil.hs b/Test/TestUtil.hs
index 776b859..88d95d2 100644
--- a/Test/TestUtil.hs
+++ b/Test/TestUtil.hs
@@ -6,19 +6,21 @@ module Test.TestUtil
 
 import Distribution.TestSuite
 
-data SimpleTest = SimpleTest String Result
-
-pure :: SimpleTest -> TestInstance
-pure (SimpleTest name result) = TestInstance (return (Finished result)) name [] [] (\_ _ -> Left "")
-
-data IO_SimpleTest = IO_SimpleTest String (IO Result)
+impure :: String -> IO Result -> TestInstance
+impure name mresult = TestInstance {
+    run = fmap Finished mresult,
+    name = name,
+    tags = [],
+    options = [],
+    setOption = \_ _ -> Left "unsupported"
+}
 
-impure :: IO_SimpleTest -> TestInstance
-impure (IO_SimpleTest name mresult) = TestInstance (fmap Finished mresult) name [] [] (\_ _ -> Left "")
+pure :: String -> Result -> TestInstance
+pure name result = impure name (return result)
 
 diff :: String -> String -> Result
-diff s t
-  = if s == t then Pass else Fail ""
+diff s t | s == t = Pass
+diff _ _ = Fail ""
 
 finish :: IO Progress -> IO Result
 finish iop = do
@@ -27,24 +29,18 @@ finish iop = do
         Finished result -> return result
         Progress _ iop' -> finish iop'
 
-concatRun :: [IO Progress] -> IO Progress
-concatRun [] = return (Finished Pass)
+concatRun :: [IO Progress] -> IO Result
+concatRun [] = return Pass
 concatRun (iop:iops) = do
     result <- finish iop
     case result of
         Pass -> concatRun iops
-        _ -> return (Finished result)
+        _ -> return result
 
 concatTestInstance :: String -> [TestInstance] -> TestInstance
-concatTestInstance tname tis = TestInstance {
-    run = concatRun (fmap run tis),
-    name = tname,
-    tags = [],
-    options = [],
-    setOption = \_ _ -> Left "unsupported"
-}
+concatTestInstance tname tis = impure tname (concatRun (fmap run tis))
 
 fastTestInstanceGroup :: String -> [TestInstance] -> Test
---fastTestGroup tname tis = testGroup tname (fmap Test tis)
+fastTestInstanceGroup tname tis | False = testGroup tname (fmap Test tis)
 fastTestInstanceGroup tname tis = Test (concatTestInstance tname tis)
 

