Revision 3603605a htools/test.hs

b/htools/test.hs
136 136 
         Nothing -> return Nothing
137 137 
         Just str -> do
138 138 
           let vs = sepSplit ',' str
139 
           (case vs of
140 
              [rng, size] -> return $ Just (read rng, read size)
141 
              _ -> fail "Invalid state given")
139 
           case vs of
140 
             [rng, size] -> return $ Just (read rng, read size)
141 
             _ -> fail "Invalid state given"
142 142 
  return args { chatty = optVerbose opts > 1,
143 143 
                replay = r
144 144 
              }
......
149 149 
  let wrap = map (wrapTest errs)
150 150 
  cmd_args <- getArgs
151 151 
  (opts, args) <- parseOpts cmd_args "test" options
152 
  tests <- (if null args
153 
              then return allTests
154 
              else (let args' = map lower args
155 
                        selected = filter ((`elem` args') . lower .
156 
                                           extractName) allTests
157 
                    in if null selected
158 
                         then do
159 
                           hPutStrLn stderr $ "No tests matching '"
160 
                              ++ intercalate " " args ++ "', available tests: "
161 
                              ++ intercalate ", " (map extractName allTests)
162 
                           exitWith $ ExitFailure 1
163 
                         else return selected))
152 
  tests <- if null args
153 
             then return allTests
154 
             else let args' = map lower args
155 
                      selected = filter ((`elem` args') . lower .
156 
                                         extractName) allTests
157 
                  in if null selected
158 
                       then do
159 
                         hPutStrLn stderr $ "No tests matching '"
160 
                            ++ unwords args ++ "', available tests: "
161 
                            ++ intercalate ", " (map extractName allTests)
162 
                         exitWith $ ExitFailure 1
163 
                       else return selected
164 164 

  		





  165
  165
  
    
  let max_count = maximum $ map (\(_, (_, t)) -> length t) tests


  		





  166
  166
  
    
  mapM_ (\(targs, (name, tl)) ->


  		





  167
  167
  
    
           transformTestOpts targs opts >>= \newargs ->


  		





  168
  168
  
    
           runTests name newargs (wrap tl) max_count) tests


  		





  169
  169
  
    
  terr <- readIORef errs


  		





  170
  
  
    
  (if terr > 0


  		





  171
  
  
    
   then do


  		





  172
  
  
    
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."


  		





  173
  
  
    
     exitWith $ ExitFailure 1


  		





  174
  
  
    
   else putStrLn "All tests succeeded.")


  		





  
  170
  
    
  if terr > 0


  		





  
  171
  
    
    then do


  		





  
  172
  
    
      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."


  		





  
  173
  
    
      exitWith $ ExitFailure 1


  		





  
  174
  
    
    else putStrLn "All tests succeeded."


  		












Also available in:
  Unified diff