[Adding tough.hs, a few strange cases for hpc to try handle andy@galois.com**20070911055102] { adddir ./tests/function addfile ./tests/function/Makefile hunk ./tests/function/Makefile 1 +# This Makefile runs the tests using GHC's testsuite framework. It +# assumes the package is part of a GHC build tree with the testsuite +# installed in ../../../testsuite. + +TOP=../../../../testsuite +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +HPCDIR=$(TOP)/../utils/hpc +HPC = $(HPCDIR)/hpc-std + +build-tix-tar:: + rm -Rf .hpc hpc001.o a.out + $(TOP)/../compiler/ghc-inplace -fhpc hpc001.hs + ./a.out + mv a.out.tix hpc_sample.tix + tar cf tixs.tar hpc_sample.tix .hpc + +# +# This is measuring coverage of the hpc tool itself. +# In the hpc directory +# % cd $ROOT/utils/hpc +# It assumes you have make a copy of hpc that +# is not compiled with -fhpc, and called it hpc-std +# % make clean ; make boot ; make ; mv hpc hpc-std +# It assumes that the utils/hpc has been compiled with +# % make clean ; make boot ; make UseStage1=YES EXTRA_HC_OPTS=-fhpc +# +HPCTOOLS_BORING = HpcParser HpcOverlay HpcLexer HpcDraft HpcCombine +BORING_FLAGS = $(foreach BORING,$(HPCTOOLS_BORING),--exclude=$(BORING)) +COVERAGE_OUT = tool-coverage.info + +HPC_ALL_TIX = hpc-all.tix + +hpc-tool-coverage-clean:: + find . -name 'hpc.tix' -print | xargs rm -f + +hpc-tool-coverage:: + $(HPC) combine $(shell find . -name 'hpc.tix' -print) --output=$(HPC_ALL_TIX) + date >> $(COVERAGE_OUT) + $(HPC) report $(HPC_ALL_TIX) --srcdir=$(HPCDIR) --xml-output >> $(COVERAGE_OUT) + echo OMIT: $(HPCTOOLS_BORING) >> $(COVERAGE_OUT) + $(HPC) report $(HPC_ALL_TIX) --srcdir=$(HPCDIR) --xml-output $(BORING_FLAGS) \ + >> $(COVERAGE_OUT) + $(HPC) markup $(HPC_ALL_TIX) --srcdir=$(HPCDIR) $(BORING_FLAGS) --destdir=html addfile ./tests/function/test.T hunk ./tests/function/test.T 1 +setTestOpts(compose(only_compiler_types(['ghc']), + compose(omit_ways(['ghci']), + skip_if_fast))) + +# Set up the hpc common variable(s). +hpc = config.top + '/../utils/hpc/hpc' + +hpc_args = ['perl ../hpcrun.pl --clear --exeext=' + config.exeext + ' --hpc=' + hpc,'-fhpc']; + +test('tough', normal, compile_and_run_with_prefix, hpc_args) + addfile ./tests/function/tough.hs hunk ./tests/function/tough.hs 1 +import Control.Exception as E + +-- This test shows what hpc can really do. + +main = do + print ("Hello") + foo "Hello" + E.catch (print (badCase 22 44)) + (\ e -> print e) + E.catch (print (badCase 22 (error "Foo"))) + (\ e -> print e) + E.catch (print "Bark") + (\ e -> print e) + (_,_) <- return $ ("Hello","World") + return () + () <- return () + t <- case () of + _ | otherwoz -> return "Hello" + _ -> error "Bad Thing Happened" + print t + print foo2 + +foo x = do + print x + return () + +unused_ a = a + +badCase :: Int -> Int -> Int +badCase a b = + if a > 100 + then error "badCase" + else if a > 1000 + then 1 + else badCase (a + 1) (b - 1) + + +foo2 = (1,2, if True then 3 else 4) + +otherwoz = True addfile ./tests/function/tough.stdout hunk ./tests/function/tough.stdout 1 +"Hello" +"Hello" +badCase +badCase +"Bark" +"Hello" +(1,2,3) + + + 76% expressions used (61/80) + 25% boolean coverage (1/4) + 0% guards (0/1), 1 always True + 33% 'if' conditions (1/3), 1 always True, 1 always False + 100% qualifiers (0/0) + 62% alternatives used (5/8) +100% local declarations used (0/0) + 83% top-level declarations used (5/6) + + +---------- + 76% expressions used (61/80) + 25% boolean coverage (1/4) + 0% guards (0/1), 1 always True + 33% 'if' conditions (1/3), 1 always True, 1 always False + 100% qualifiers (0/0) + 62% alternatives used (5/8) +100% local declarations used (0/0) + 83% top-level declarations used (5/6) + + +Writing: Main.hs.html + +

+    1 import Control.Exception as E
+    2 
+    3 -- This test shows what hpc can really do.
+    4 
+    5 main = do
+    6   print ("Hello")
+    7   foo "Hello"
+    8   E.catch (print (badCase 22 44))
+    9           (\ e -> print e)
+   10   E.catch (print (badCase 22 (error "Foo")))
+   11           (\ e -> print e)
+   12   E.catch (print "Bark")
+   13           (\ e -> print e)
+   14   (_,_) <- return $ ("Hello","World")
+   15   return ()
+   16   () <- return ()
+   17   t <- case () of
+   18     _ | otherwoz -> return "Hello"
+   19     _             -> error "Bad Thing Happened"
+   20   print t
+   21   print foo2
+   22 
+   23 foo x = do
+   24   print x
+   25   return ()
+   26 
+   27 unused_ a = a
+   28 
+   29 badCase :: Int -> Int -> Int
+   30 badCase a b = 
+   31         if a > 100 
+   32         then error "badCase" 
+   33         else if a > 1000 
+   34              then 1 
+   35              else badCase (a + 1) (b - 1)
+   36 
+   37 
+   38 foo2 = (1,2, if True then 3 else 4)
+   39 
+   40 otherwoz = True
+
+