HTF (empty) → 0.1
raw patch · 12 files changed
+1407/−0 lines, 12 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, containers, directory, process, random, template-haskell
Files
- HTF.cabal +39/−0
- LICENSE +487/−0
- Setup.hs +5/−0
- Test/Framework.hs +83/−0
- Test/Framework/Configuration.hs +4/−0
- Test/Framework/FileBasedTest.hs +190/−0
- Test/Framework/HUnitWrapper.hs +187/−0
- Test/Framework/Location.hs +26/−0
- Test/Framework/Process.hs +70/−0
- Test/Framework/QuickCheckWrapper.hs +141/−0
- Test/Framework/Utils.hs +109/−0
- scripts/HTFpp.hs +66/−0
+ HTF.cabal view
@@ -0,0 +1,39 @@+Name: HTF+Version: 0.1+License: LGPL+License-file: LICENSE+Author: Stefan Wehr <wehr@informatik.uni-freiburg.de>+Stability: Beta+Category: Testing+Synopsis: The Haskell Test Framework+Description: The HTF lets you write HUnit tests (http://hunit.sourceforge.net)+ and QuickCheck (http://www.cs.chalmers.se/~rjmh/QuickCheck/) properties+ in an easy and convenient way. Additionally, the HTF provides a facility+ for testing programs by running them and comparing the actual output with+ the expected output (so called "file-based tests").++ The HTF uses Template Haskell to collect all tests and properties,+ so you do not need to write boilerplate code for that purpose.+ Preprocessor macros provide you with file name and line number information+ for tests and properties that failed.+homepage: http://www.informatik.uni-freiburg.de/~wehr/software/haskell/++tested-with: GHC==6.8.2+Build-Depends: HUnit, QuickCheck<2, template-haskell, base>3, random, containers, process, directory+Build-Type: Simple++Exposed-Modules: Test.Framework+Other-Modules:+ Test.Framework.Location+ Test.Framework.HUnitWrapper+ Test.Framework.QuickCheckWrapper+ Test.Framework.Configuration+ Test.Framework.Process+ Test.Framework.FileBasedTest+ Test.Framework.Utils++Executable: htf-pp+Main-Is: HTFpp.hs+Hs-Source-Dirs: scripts, .+Other-Modules: Test.Framework.Process+ghc-options: -threaded -Wall
+ LICENSE view
@@ -0,0 +1,487 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL. It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++ This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it. You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations below.++ When we speak of free software, we are referring to freedom of use,+not price. Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++ To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights. These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++ For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you. You must make sure that they, too, receive or can get the source+code. If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it. And you must show them these terms so they know their rights.++ We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++ To protect each distributor, we want to make it very clear that+there is no warranty for the free library. Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++ Finally, software patents pose a constant threat to the existence of+any free program. We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder. Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++ Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License. This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License. We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++ When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library. The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom. The Lesser General+Public License permits more lax criteria for linking other code with+the library.++ We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License. It also provides other free software developers Less+of an advantage over competing non-free programs. These disadvantages+are the reason we use the ordinary General Public License for many+libraries. However, the Lesser license provides advantages in certain+special circumstances.++ For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it becomes+a de-facto standard. To achieve this, non-free programs must be+allowed to use the library. A more frequent case is that a free+library does the same job as widely used non-free libraries. In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++ In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software. For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++ Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++ The precise terms and conditions for copying, distribution and+modification follow. Pay close attention to the difference between a+"work based on the library" and a "work that uses the library". The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++ GNU LESSER GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++ A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++ The "Library", below, refers to any such software library or work+which has been distributed under these terms. A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language. (Hereinafter, translation is+included without limitation in the term "modification".)++ "Source code" for a work means the preferred form of the work for+making modifications to it. For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control compilation+and installation of the library.++ Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it). Whether that is true depends on what the Library does+and what the program that uses the Library does.+ + 1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++ You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++ 2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) The modified work must itself be a software library.++ b) You must cause the files modified to carry prominent notices+ stating that you changed the files and the date of any change.++ c) You must cause the whole of the work to be licensed at no+ charge to all third parties under the terms of this License.++ d) If a facility in the modified Library refers to a function or a+ table of data to be supplied by an application program that uses+ the facility, other than as an argument passed when the facility+ is invoked, then you must make a good faith effort to ensure that,+ in the event an application does not supply such function or+ table, the facility still operates, and performs whatever part of+ its purpose remains meaningful.++ (For example, a function in a library to compute square roots has+ a purpose that is entirely well-defined independent of the+ application. Therefore, Subsection 2d requires that any+ application-supplied function or table used by this function must+ be optional: if the application does not supply it, the square+ root function must still compute square roots.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library. To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License. (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.) Do not make any other change in+these notices.++ Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++ This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++ 4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++ If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++ 5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library". Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++ However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library". The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++ When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library. The+threshold for this to be true is not precisely defined by law.++ If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work. (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++ Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++ 6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++ You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License. You must supply a copy of this License. If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License. Also, you must do one+of these things:++ a) Accompany the work with the complete corresponding+ machine-readable source code for the Library including whatever+ changes were used in the work (which must be distributed under+ Sections 1 and 2 above); and, if the work is an executable linked+ with the Library, with the complete machine-readable "work that+ uses the Library", as object code and/or source code, so that the+ user can modify the Library and then relink to produce a modified+ executable containing the modified Library. (It is understood+ that the user who changes the contents of definitions files in the+ Library will not necessarily be able to recompile the application+ to use the modified definitions.)++ b) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (1) uses at run time a+ copy of the library already present on the user's computer system,+ rather than copying library functions into the executable, and (2)+ will operate properly with a modified version of the library, if+ the user installs one, as long as the modified version is+ interface-compatible with the version that the work was made with.++ c) Accompany the work with a written offer, valid for at+ least three years, to give the same user the materials+ specified in Subsection 6a, above, for a charge no more+ than the cost of performing this distribution.++ d) If distribution of the work is made by offering access to copy+ from a designated place, offer equivalent access to copy the above+ specified materials from the same place.++ e) Verify that the user has already received a copy of these+ materials or that you have already sent this user a copy.++ For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it. However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++ It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system. Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++ 7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++ a) Accompany the combined library with a copy of the same work+ based on the Library, uncombined with any other library+ facilities. This must be distributed under the terms of the+ Sections above.++ b) Give prominent notice with the combined library of the fact+ that part of it is a work based on the Library, and explaining+ where to find the accompanying uncombined form of the same work.++ 8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License. Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License. However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++ 9. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Library or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++ 10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++ 11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all. For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under any+particular circumstance, the balance of the section is intended to apply,+and the section as a whole is intended to apply in other circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License may add+an explicit geographical distribution limitation excluding those countries,+so that distribution is permitted only in or among countries not thus+excluded. In such case, this License incorporates the limitation as if+written in the body of this License.++ 13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number. If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation. If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++ 14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission. For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this. Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++ NO WARRANTY++ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++ END OF TERMS AND CONDITIONS+++------------------------------------------------------------------------++The ncurses binding was originally written by John Meacham, and is+available under the license:++Unless otherwise stated the following licence applies:++Copyright (c) 2002-2004 John Meacham (john at repetae dot net)++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ Test/Framework.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS -fth #-}++-- +-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework (++ module HU, module QC, module FBT,++ tests++) where++import Data.Maybe+import Language.Haskell.TH++import Test.Framework.HUnitWrapper as HU+import Test.Framework.QuickCheckWrapper as QC+import Test.Framework.FileBasedTest as FBT++tests :: String -> Q [Dec] -> Q [Dec]+tests name decs = + do decs' <- decs+ -- runIO $ putStrLn (show decs')+ moduleName <- currentModule+ let ts = collectTests decs'+ props = collectProps decs'+ testName = moduleName ++ "." ++ name+ e <- [| HU.TestLabel testName + (HU.TestList $(listE (map mkExp ts ++ + map (mkPropExp testName) props))) |]+ let lete = LetE decs' e+ suiteDec = ValD (VarP (mkName name)) (NormalB lete) []+ resDecs = [suiteDec]+ -- runIO $ putStrLn (show props) --(pprint resDecs)+ return resDecs+ where+ collectTests :: [Dec] -> [Name]+ collectTests = mapMaybe f + where f (ValD (VarP name) _ _) | isTestName (nameBase name) = Just name+ f _ = Nothing + collectProps :: [Dec] -> [(Name, String, Bool)]+ collectProps = mapMaybe f+ where f (ValD (VarP name) _ _) = analyzePropName name+ f (FunD name _) = analyzePropName name+ f _ = Nothing + isTestName :: String -> Bool+ isTestName ('t':'e':'s':'t':'_':s) | not (null s) = True+ isTestName _ = False+ analyzePropName :: Name -> Maybe (Name, String, Bool)+ analyzePropName name =+ case nameBase name of+ ('p':'r':'o':'p':'_':'c':'f':'g':'_':s) + | not (null s) -> Just (name, s, True)+ ('p':'r':'o':'p':'_':s) + | not (null s) -> Just (name, s, False)+ _ -> Nothing+ mkExp :: Name -> Q Exp+ mkExp name = + let s = nameBase name+ in [| HU.TestLabel s (HU.TestCase $(varE name)) |]+ mkPropExp :: String -> (Name, String, Bool) -> Q Exp+ mkPropExp testName (name, s, customCfg) =+ let fullName = testName `joinPathElems` s+ exp = if customCfg then [| $(varE name) |]+ else [| (id, $(varE name)) |]+ in [| HU.TestLabel s + (HU.TestCase (testableAsAssertion fullName $(exp))) |]
+ Test/Framework/Configuration.hs view
@@ -0,0 +1,4 @@+-- GENERATED AUTOMATICALLY, DO NOT EDIT!!+module Test.Framework.Configuration where+import Data.Version+ghcVersion = Version {versionBranch = [6,4,1], versionTags = []}
+ Test/Framework/FileBasedTest.hs view
@@ -0,0 +1,190 @@+-- +-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework.FileBasedTest ( + + Diff, FBTConfig(..), ++ defaultFBTConfig, defaultDiff,++ fileBasedTests++) where++import Prelude hiding ( catch )++import System.IO+import System.Exit+import Control.Exception+import System.Directory +import Data.List ( mapAccumL )+import qualified Data.Map as Map+import Control.Monad++import Test.Framework.Process+import Test.Framework.HUnitWrapper as HU+import Test.Framework.Utils++type Diff = Maybe FilePath -- Name of the file that contains the expected output.+ -- If the parameter is Nothing, then no output+ -- is expected.+ -> String -- Actual output+ -> IO (Maybe String) -- A Nothing value means ok, otherwise the+ -- Just value wraps the error message++data FileBasedTest = FileBasedTest+ { fbt_shouldFail :: Bool+ , fbt_cmd :: String+ , fbt_stdinFile :: Maybe FilePath+ , fbt_stdoutFile :: Maybe FilePath+ , fbt_stderrFile :: Maybe FilePath+ -- functions for comparing output on stdout and stderr.+ , fbt_stdoutCmp :: Diff+ , fbt_stderrCmp :: Diff+ }++runFileBasedTest :: FileBasedTest -> HU.Assertion+runFileBasedTest fbt = + do inp <- case fbt_stdinFile fbt of+ Nothing -> return Nothing+ Just f -> do s <- readFile f+ return $ Just s+ (out,err,exit) <- popenShell (fbt_cmd fbt) inp+ case exit of+ ExitSuccess | fbt_shouldFail fbt + -> HU.assertFailure ("test is supposed to fail but succeeded")+ ExitFailure i | not $ fbt_shouldFail fbt+ -> do hPutStrLn stderr $ "stderr for " ++ show (fbt_cmd fbt) ++ ":"+ hPutStr stderr err+ putStrLn $ "stdout for " ++ show (fbt_cmd fbt) ++ ":"+ putStr out+ HU.assertFailure ("test is supposed to succeed but failed with " +++ "exit code " ++ show i)+ _ -> do cmpOut <- cmp (fbt_stdoutFile fbt) (fbt_stdoutCmp fbt)+ out "Mismatch on stdout:\n"+ cmpErr <- cmp (fbt_stderrFile fbt) (fbt_stderrCmp fbt)+ err "Mismatch on stderr:\n"+ case (cmpOut, cmpErr) of+ (Nothing, Nothing) -> return ()+ (x1, x2) -> HU.assertFailure (x1 `concatMaybes` x2)+ where cmp expectFile cmpAction real label = + do res <- cmpAction expectFile real+ case res of+ Nothing -> return Nothing+ Just s -> return $ Just (label ++ s)+ concatMaybes Nothing Nothing = ""+ concatMaybes (Just s) Nothing = s+ concatMaybes (Nothing) (Just s) = s+ concatMaybes (Just s1) (Just s2) = s1 ++ "\n" ++ s2+++data FBTConfig = FBTConfig { fbt_stdinSuffix :: String+ , fbt_stdoutSuffix :: String+ , fbt_stderrSuffix :: String+ , fbt_dynConfigName :: String+ , fbt_stdoutDiff :: Diff+ , fbt_stderrDiff :: Diff }++defaultDiff :: Diff+defaultDiff expectFile real = + do mexe <- findExecutable "diff"+ let exe = case mexe of+ Just p -> p+ Nothing -> error ("diff command not in path")+ case expectFile of+ Nothing | null real -> return Nothing+ | otherwise -> return $ Just ("no output expected, but given:\n" + ++ real)+ Just expect ->+ do (out, err, exitCode) <- popen exe ["-u", expect, "-"] (Just real)+ case exitCode of+ ExitSuccess -> return Nothing -- no difference+ ExitFailure 1 -> return $ Just out -- files differ+ ExitFailure i -> error ("diff command failed with exit code " ++ + show i ++ ": " ++ err)++defaultFBTConfig = FBTConfig { fbt_stdinSuffix = ".in"+ , fbt_stdoutSuffix = ".out"+ , fbt_stderrSuffix = ".err"+ , fbt_dynConfigName = "FBTConfig"+ , fbt_stdoutDiff = defaultDiff+ , fbt_stderrDiff = defaultDiff }++fileBasedTests :: String -- id for the tests+ -> FilePath -- root directory of the test hierarchy+ -> String -- name of executable+ -> String -- filename suffix for input file+ -> FBTConfig -- configuration+ -> IO HU.Test+fileBasedTests id root exe suf cfg = + do let prune root _ = do dynCfg <- readDynCfg Map.empty+ (root </> fbt_dynConfigName cfg)+ return $ dyn_skip dynCfg+ inputFiles <- collectFiles root suf prune+ (_, tests) <- mapAccumLM genTest Map.empty inputFiles+ return $ HU.TestLabel id $ HU.TestList tests+ where genTest :: DynamicConfigMap -> FilePath -> IO (DynamicConfigMap, HU.Test)+ genTest map fname =+ do stdinf <- maybeFile $ replaceSuffix fname (fbt_stdinSuffix cfg)+ stdoutf <- maybeFile $ replaceSuffix fname (fbt_stdoutSuffix cfg)+ stderrf <- maybeFile $ replaceSuffix fname (fbt_stderrSuffix cfg)+ let configFile = dirname fname </> fbt_dynConfigName cfg+ dynCfg <- readDynCfg map configFile+ let cmd = exe ++ " " ++ dropSpace (dyn_flags dynCfg) ++ " " ++ fname+ shouldFail = dyn_shouldFail dynCfg+ let fbt = FileBasedTest+ { fbt_shouldFail = shouldFail+ , fbt_cmd = cmd+ , fbt_stdinFile = stdinf+ , fbt_stdoutFile = stdoutf+ , fbt_stderrFile = stderrf+ , fbt_stdoutCmp = fbt_stdoutDiff cfg+ , fbt_stderrCmp = fbt_stderrDiff cfg+ }+ return (Map.insert configFile dynCfg map,+ HU.TestLabel fname $ HU.TestCase $ runFileBasedTest fbt)++data DynamicConfig = DynamicConfig { dyn_skip :: Bool+ , dyn_flags :: String+ , dyn_shouldFail :: Bool }++type DynamicConfigMap = Map.Map FilePath DynamicConfig++defaultDynCfg = DynamicConfig False "" False++readDynCfg :: DynamicConfigMap -> FilePath -> IO DynamicConfig+readDynCfg m f = + do case Map.lookup f m of+ Just dynCfg -> return dynCfg+ Nothing ->+ do b <- doesFileExist f+ if not b then return $ defaultDynCfg+ else do s <- readFile f+ return $ foldl (parse f) defaultDynCfg $ + filter (not . isUseless) (map dropSpace (lines s))+ where isUseless :: String -> Bool+ isUseless [] = True+ isUseless ('#':_) = True+ isUseless _ = False+ parse :: FilePath -> DynamicConfig -> String -> DynamicConfig+ parse _ cfg "Skip" = cfg { dyn_skip = True }+ parse _ cfg "Fail" = cfg { dyn_shouldFail = True }+ parse _ cfg ('F':'l':'a':'g':'s':':':flags) = cfg { dyn_flags = flags }+ parse f _ l = error ("invalid line in dynamic configuration file `" +++ f ++ "': " ++ show l)+
+ Test/Framework/HUnitWrapper.hs view
@@ -0,0 +1,187 @@+--+-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+--+-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework.HUnitWrapper (++ HU.Assertion,++ assertBool_, assertEqual_, assertEqualNoShow_, assertNotNull_, assertNull_,+ assertSetEqual_, assertThrows_,++ assertFailure,++ HU.Test(..), runTestTT,++ joinPathElems, showPathLabel++) where++import System.IO ( stderr )+import Data.List ( (\\) )+import Control.Exception+import Data.Version+import qualified Test.HUnit as HU++import Test.Framework.Location+import Test.Framework.Configuration++--+-- Assertions+--++-- WARNING: do not forget to add a preprocessor macro for new assertions!!++assertFailure :: String -> IO ()+assertFailure s =+ if ghcVersion <= buggyVersion+ then -- because of a bug in HUnit shipped with GHC 6.4.1, we must+ -- throw an exception e such that (show e) does not have a prefix+ -- like `user error'.+ error (hunitPrefix ++ s)+ else HU.assertFailure s+ where hunitPrefix = "HUnit:"+ buggyVersion = Version [6,4,1] []++assertBool_ :: Location -> Bool -> HU.Assertion+assertBool_ loc False = assertFailure ("assert failed at " ++ showLoc loc)+assertBool_ loc True = return ()++assertEqual_ :: (Eq a, Show a) => Location -> a -> a -> HU.Assertion+assertEqual_ loc expected actual =+ if expected /= actual+ then assertFailure msg+ else return ()+ where msg = "assertEqual failed at " ++ showLoc loc +++ "\n expected: " ++ show expected ++ "\n but got: " ++ show actual++assertEqualNoShow_ :: Eq a => Location -> a -> a -> HU.Assertion+assertEqualNoShow_ loc expected actual =+ if expected /= actual+ then assertFailure ("assertEqualNoShow failed at " ++ showLoc loc)+ else return ()++assertSetEqual_ :: (Eq a, Show a) => Location -> [a] -> [a] -> HU.Assertion+assertSetEqual_ loc expected actual =+ let ne = length expected+ na = length actual+ in case () of+ _| ne /= na ->+ assertFailure ("assertSetEqual failed at " ++ showLoc loc+ ++ "\n expected length: " ++ show ne+ ++ "\n actual length: " ++ show na)+ | not (unorderedEq expected actual) ->+ assertFailure ("assertSetEqual failed at " ++ showLoc loc+ ++ "\n expected: " ++ show expected+ ++ "\n actual: " ++ show actual)+ | otherwise -> return ()+ where unorderedEq l1 l2 =+ null (l1 \\ l2) && null (l2 \\ l1)+++assertNotNull_ :: Location -> [a] -> HU.Assertion+assertNotNull_ loc [] = assertFailure ("assertNotNull failed at " ++ showLoc loc)+assertNotNull_ _ (_:_) = return ()++assertNull_ :: Location -> [a] -> HU.Assertion+assertNull_ loc (_:_) = assertFailure ("assertNull failed at " ++ showLoc loc)+assertNull_ loc [] = return ()++assertThrows_ :: Location -> IO a -> (Exception -> Bool) -> HU.Assertion+assertThrows_ loc io f =+ do res <- try io+ case res of+ Right _ -> assertFailure ("assertThrows failed at " ++ showLoc loc +++ ": no exception was thrown")+ Left e -> if f e then return ()+ else assertFailure ("assertThrows failed at " +++ showLoc loc +++ ": wrong exception was thrown: " +++ show e)++--+-- Test runner+--++{-+We use our own test runner because HUnit print test paths a bit unreadable:+If a test list contains a named tests, then HUnit prints `i:n' where i+is the index of the named tests and n is the name.+-}++{-+`runTestText` executes a test, processing each report line according+to the given reporting scheme. The reporting scheme's state is+threaded through calls to the reporting scheme's function and finally+returned, along with final count values.+-}++runTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)+runTestText (HU.PutText put us) t = do+ put allTestsStr True us+ (counts, us') <- HU.performTest reportStart reportError reportFailure us t+ us'' <- put (HU.showCounts counts) True us'+ return (counts, us'')+ where+ allTestsStr = unlines ("All tests:" :+ map (\p -> " " ++ showPath p) (HU.testCasePaths t))+ reportStart ss us = put (HU.showCounts (HU.counts ss)) False us+ reportError = reportProblem "Error:" "Error in: "+ reportFailure = reportProblem "Failure:" "Failure in: "+ reportProblem p0 p1 msg ss us = put line True us+ where line = "### " ++ kind ++ path' ++ '\n' : msg ++ "\n"+ kind = if null path' then p0 else p1+ path' = showPath (HU.path ss)++++{-+`showPath` converts a test case path to a string, separating adjacent+elements by ':'. An element of the path is quoted (as with `show`)+when there is potential ambiguity.+-}++showPath :: HU.Path -> String+showPath [] = ""+showPath nodes = foldr1 joinPathElems+ (map showNode (filterNodes (reverse nodes)))+ where showNode (HU.ListItem n) = show n+ showNode (HU.Label label) = showPathLabel label+ filterNodes (HU.ListItem _ : l@(HU.Label _) : rest) =+ l : filterNodes rest+ filterNodes [] = []+ filterNodes (x:rest) = x : filterNodes rest++joinPathElems :: String -> String -> String+joinPathElems s1 s2 = s1 ++ ":" ++ s2++showPathLabel :: String -> String+showPathLabel s =+ let ss = show s+ in if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s++{-+`runTestTT` provides the "standard" text-based test controller.+Reporting is made to standard error, and progress reports are+included. For possible programmatic use, the final counts are+returned. The "TT" in the name suggests "Text-based reporting to the+Terminal".+-}++runTestTT :: HU.Test -> IO HU.Counts+runTestTT t = do (counts, _) <- runTestText (HU.putTextToHandle stderr False) t+ return counts
+ Test/Framework/Location.hs view
@@ -0,0 +1,26 @@+-- +-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework.Location where+++type Location = (String, Int)++showLoc :: Location -> String+showLoc (f,n) = f ++ ":" ++ show n+
+ Test/Framework/Process.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS -cpp #-}+-- +-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++-- stolen from Yi++--+-- | A Posix.popen compatibility mapping.+-- Based on PosixCompat, originally written by Derek Elkins for lambdabot+--+module Test.Framework.Process ( popen, popenShell ) where++import System.IO+import System.Process+import System.Exit+import Control.Concurrent (forkIO)+import qualified Control.Exception++popenShell :: String -> Maybe String -> IO (String,String,ExitCode)+popenShell cmd = popen' $ runInteractiveCommand cmd++popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ExitCode)+popen file args = + popen' $ runInteractiveProcess file args Nothing Nothing++popen' :: IO (Handle, Handle, Handle, ProcessHandle) + -> Maybe String+ -> IO (String,String,ExitCode)+popen' run minput = + Control.Exception.handle (\e -> return ([],show e,error (show e))) $ do++ (inp,out,err,pid) <- run++ case minput of+ Just input -> hPutStr inp input >> hClose inp -- importante!+ Nothing -> return ()++ -- Now, grab the input+ output <- hGetContents out+ errput <- hGetContents err++ -- SimonM sez:+ -- ... avoids blocking the main thread, but ensures that all the+ -- data gets pulled as it becomes available. you have to force the+ -- output strings before waiting for the process to terminate.+ --+ forkIO (Control.Exception.evaluate (length output) >> return ())+ forkIO (Control.Exception.evaluate (length errput) >> return ())++ -- And now we wait. We must wait after we read, unsurprisingly.+ ecode <- waitForProcess pid -- blocks without -threaded, you're warned.++ -- so what's the point of returning the pid then?+ return (output,errput,ecode)+
+ Test/Framework/QuickCheckWrapper.hs view
@@ -0,0 +1,141 @@+-- +-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework.QuickCheckWrapper (++ Id, Config(..), makeVerbose, setMaxTest,++ testableAsAssertion,+ + module Test.QuickCheck+) where++import qualified Data.Map as Map+import Control.Concurrent.MVar+import Control.Exception ( throw )+import System.IO+import System.IO.Unsafe+import System.Random+import Data.List( group, sort, intersperse )+import Data.Char+import Test.QuickCheck hiding ( Config(..), defaultConfig,+ test, quickCheck, verboseCheck, check )+import Test.QuickCheck.Batch+import Test.Framework.HUnitWrapper++type Id = String++data Config = Config+ { configMaxTest :: Int+ , configMaxFail :: Int+ , configSize :: Int -> Int+ , configEvery :: String -> IO ()+ }++data QCState = QCState { qc_config :: Config }+ +defaultConfig = Config+ { configMaxTest = 100+ , configMaxFail = 1000+ , configSize = (+ 3) . (`div` 2)+ , configEvery = \_ -> return ()+ }++verboseConfigEvery = hPutStr stderr++makeVerbose :: Config -> Config+makeVerbose cfg = cfg { configEvery = verboseConfigEvery }++setMaxTest :: Int -> Config -> Config+setMaxTest i cfg = cfg { configMaxTest = i }++qcState :: MVar QCState+qcState = unsafePerformIO (newMVar (QCState defaultConfig))++testableAsAssertion :: Testable a => Id -> (Config -> Config, a) -> Assertion+testableAsAssertion id (f, t) = + withMVar qcState $ \state ->+ do let cfg = f (qc_config state)+ configEvery cfg (prop id ++ "\n")+ res <- check cfg t+ case res of+ PropOk s -> do hPutStrLn stderr $ " * " ++ prop id ++ (strip s)+ hPutStrLn stderr ""+ PropFailure s -> assertFailure $ prop id ++ (strip s)+ PropExhausted s -> assertFailure $ prop id ++ (strip s)+ return ()+ where prop s = "Property `" ++ s ++ "' "+ strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace++data PropResult = PropOk String+ | PropFailure String+ | PropExhausted String+ +check :: Testable a => Config -> a -> IO PropResult+check config a =+ do rnd <- newStdGen+ tests config (evaluate a) rnd 0 0 []++tests :: Config -> Gen Result -> StdGen + -> Int -> Int -> [[String]] -> IO PropResult+tests config gen rnd0 ntest nfail stamps+ | ntest == configMaxTest config = + return $ done PropOk "OK, passed" ntest stamps+ | nfail == configMaxFail config = + return $ done PropExhausted "Arguments exhausted after" ntest stamps+ | otherwise =+ do configEvery config $ show ntest ++ ":\n" ++ unlines (arguments result)+ case ok result of+ Nothing ->+ tests config gen rnd1 ntest (nfail+1) stamps+ Just True ->+ tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)+ Just False ->+ return $ PropFailure ("Falsifiable, after "+ ++ show ntest+ ++ " tests:\n"+ ++ unlines (arguments result)+ )+ where+ result = generate (configSize config ntest) rnd2 gen+ (rnd1,rnd2) = split rnd0++done :: (String -> PropResult) -> String -> Int -> [[String]] -> PropResult+done f mesg ntest stamps =+ f ( mesg ++ " " ++ show ntest ++ " tests" ++ table )+ where+ table = display+ . map entry+ . reverse+ . sort+ . map pairLength+ . group+ . sort+ . filter (not . null)+ $ stamps++ display [] = ".\n"+ display [x] = " (" ++ x ++ ").\n"+ display xs = ".\n" ++ unlines (map (++ ".") xs)++ pairLength xss@(xs:_) = (length xss, xs)+ entry (n, xs) = percentage n ntest+ ++ " "+ ++ concat (intersperse ", " xs)++ percentage n m = show ((100 * n) `div` m) ++ "%"
+ Test/Framework/Utils.hs view
@@ -0,0 +1,109 @@+-- +-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This library is free software; you can redistribute it and/or+-- modify it under the terms of the GNU Lesser General Public+-- License as published by the Free Software Foundation; either+-- version 2.1 of the License, or (at your option) any later version.+-- +-- This library is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- Lesser General Public License for more details.+--+-- You should have received a copy of the GNU Lesser General Public+-- License along with this library; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA+--++module Test.Framework.Utils where++import System.Directory+import Data.Char ++infixr 6 </>++(</>) :: FilePath -> FilePath -> FilePath+[] </> b = b+a </> b = a ++ "/" ++ b++basename :: FilePath -> FilePath+basename p = reverse $ takeWhile (/= '/') $ reverse p++dirname :: FilePath -> FilePath+dirname p =+ case reverse $ dropWhile (/= '/') $ reverse p of+ [] -> "."+ p' -> p'++startswith :: String -> String -> Bool+startswith s pref = + let n = length pref+ in take n s == pref++endswith :: String -> String -> Bool+endswith s suf = + let n = length s - length suf+ in drop n s == suf++dropSuffix :: FilePath -> FilePath+dropSuffix f = reverse . tail . dropWhile (/= '.') $ reverse f++replaceSuffix :: FilePath -> String -> FilePath+replaceSuffix f suf = dropSuffix f ++ suf++-- > dropSpace " abc " ===> "abc"+dropSpace :: [Char] -> [Char]+dropSpace = let f = reverse . dropWhile isSpace in f . f++data DirectoryEntryType = File | Directory | Other + deriving (Eq, Show)++directoryEntryType :: FilePath -> IO DirectoryEntryType+directoryEntryType fp = + do b <- doesFileExist fp+ if b then return File else do b <- doesDirectoryExist fp+ return $ if b then Directory else Other++collectFiles :: FilePath -- the directory to start from+ -> String -- suffix of the file names to collect+ -> (FilePath -> [FilePath] -> IO Bool) -- predicate that determines+ -- whether files below a certain + -- directory should be pruned.+ -- The first argument is the+ -- name of the directory, the+ -- second the entries of the + -- directory+ -> IO [FilePath]+collectFiles root suf prune = + do entries <- getDirectoryContents root+ b <- prune root entries + if b then return []+ else do all <- mapM (collect root) entries+ return $ concat all+ where collect root f | f == "." || f == ".." = return []+ | otherwise =+ do t <- directoryEntryType (root </> f)+ case t of+ Directory -> collectFiles (root </> f) suf prune+ File | f `endswith` suf -> return [root </> f]+ _ -> return []++maybeFile :: FilePath -> IO (Maybe FilePath)+maybeFile f = + do b <- doesFileExist f+ return $ if b then Just f else Nothing++-- monadic version of mapAccumL+mapAccumLM :: Monad m+ => (acc -> x -> m (acc, y)) -- Function of elt of input list+ -- and accumulator, returning new+ -- accumulator and elt of result list+ -> acc -- Initial accumulator + -> [x] -- Input list+ -> m (acc, [y]) -- Final accumulator and result list+mapAccumLM _ s [] = return (s, [])+mapAccumLM f s (x:xs) = do (s', y ) <- f s x + (s'',ys) <- mapAccumLM f s' xs+ return (s'',y:ys)+
+ scripts/HTFpp.hs view
@@ -0,0 +1,66 @@+--+-- Copyright (c) 2005 Stefan Wehr - http://www.stefanwehr.de+--+-- This program is free software; you can redistribute it and/or+-- modify it under the terms of the GNU General Public License as+-- published by the Free Software Foundation; either version 2 of+-- the License, or (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+-- General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA+-- 02111-1307, USA.+--++module Main where++import System.IO+import System.Environment+import System.Exit++import Test.Framework.Process++assertions :: [String]+assertions = [ "assertBool"+ , "assertEqual"+ , "assertEqualNoShow"+ , "assertSetEqual"+ , "assertNull"+ , "assertNotNull"+ , "assertThrows"+ ]++macros :: String+macros = unlines $+ "#define SRC_LOC_ (__FILE__, __LINE__)" :+ map define assertions+ where define s = "#define " ++ s ++ " (" ++ s ++ "_ SRC_LOC_)"++main :: IO ()+main =+ do prog <- getProgName+ args <- getArgs+ if length args /= 4+ then hPutStrLn stderr+ ("Usage: " ++ prog +++ " original-filename input-filename output-filename "+ ++ "cpp-command")+ else let orig = args!!0+ infile = args!!1+ outfile = args!!2+ cpp = args!!3+ fstLine = "#line 1 \"" ++ orig ++ "\"\n"+ in do inString <- readFile infile+ (out,err,_) <- popen cpp ["-w"]+ (Just $ macros ++ fstLine +++ inString)+ if null err+ then do writeFile outfile out+ exitWith ExitSuccess+ else do hPutStrLn stderr err+ exitWith (ExitFailure 1)