Commit 2174f083 authored by stu115253's avatar stu115253
Browse files

QuickCheck test for parsing external file

parent 93114598
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Curry.Syntax (parseModule, parseHeader, parseInterface, lexSource)
import Curry.Base.Message (runMessageT)
import Data.Functor.Identity (runIdentity)
import Curry.Base.Message (runMsg)
--import Data.Functor.Identity (runIdentity)
import System.Exit (exitFailure)
import Test.QuickCheck.All (quickCheckAll)
import Test.QuickCheck.Monadic (PropertyM, monadicIO, assert, run)
......@@ -34,27 +34,37 @@ fileWorks name =
stringWorks content =
withModule content isRight-}
isRight :: Either a b -> Bool
isRight (Left _) = False
isRight (Right _) = True
--prop_a = monadic $ (return True :: IO Bool)
prop_a :: Property
prop_a = monadicIO $ (assert True :: PropertyM IO ())
prop_file :: Property -- M IO ()
prop_file = monadicIO $ do
content <- run (readFile "C:/Dropbox/Arbeit/stu115253s-curry-base/testsuite/Main.hs" :: IO String)
prop_testFileExists :: Property
prop_testFileExists = monadicIO $ do
content <- run (readFile "C:/Dropbox/Arbeit/stu115253s-curry-base/testsuite/easy.hs" :: IO String)
(assert (((content :: String) /= []) :: Bool)) :: PropertyM IO ()
parseFileProp :: String -> Property
parseFileProp name = monadicIO $ do
content <- run $ readFile name
case runMsg $ parseModule "" content of
Left err -> do
run $ print $ show err
assert False
Right (a, msg) ->
assert True
sprop_parsing :: IO Bool
sprop_parsing =
isTrue [ try lexSource, try parseInterface, try parseHeader, try parseModule ]
where
try strategy = do
content <- readFile "C:/Dropbox/Arbeit/stu115253s-curry-base/testsuite/Main.hs"
return $ isRight $ runIdentity $ runMessageT $ strategy "" content
isTrue [] = return True
isTrue (ioBool:rest) = do
bool <- ioBool
if bool then isTrue rest else return False
prop_parseTestFile :: Property
prop_parseTestFile = parseFileProp "C:/Dropbox/Arbeit/stu115253s-curry-base/testsuite/easy.hs"
{- case res of
Left e ->
print "Err" --(show e)
assert False
Right (x, msgs) ->
assert True-}
-- lexSource --> [(Position, L.Token)]
......
module Main where
main :: IO Int
main = do return 0
\ No newline at end of file
module A where
import B.C (foo)
main = print foo
\ No newline at end of file
-- NEW: Anonymous variable
f _ = _
g x = _ + x
h x = _ + x + _
module B.C where
foo = "foo"
\ No newline at end of file
I don't know if it's really a bug or I only don't understand records well.
The following gives a compiling error:
> fun :: a -> Bool
> fun _ = True
> fun3 :: a -> a -> Bool
> fun3 _ _ = False
> type Rec a = { a :: a, b :: Bool }
> testRecSel1 = { a := 'c', b := True } :> a
> testRecSel2 x y = { a := fun x, b := fun3 y y } :> a
The type of the record used in testRecSel1 somehow propagates
to the type of the record used in testRecSel2.
If one comments the definition of testRecSel1 then there is no error.
test :: a
test = x
where
x :: b
x = unknown
test1 :: a
test1 = x
where x :: a
x free
test2 :: a -> b
test2 = let x = unknown :: a -> b in x
test3 :: a -> b
test3 = let x free in x :: a -> b
test4 :: (Bool, ())
test4 = (x, x)
where x free
test5 :: (Bool, ())
test5 = (x, x)
where
x :: a
x = unknown
\ No newline at end of file
Loading this module (in pakcs) leads to cymake <<loop>>.
it might be interesting that the last line is important for this error to
occur; if the last line is omitted or changed to "i = 3" then the expected
error "recursive synonym types" is properly printed.
> module Bug489 where
> type A = B
> type B = A
> i = Just ()
import Prelude
($) :: (a -> b) -> a -> b
($) f x = f x
\ No newline at end of file
f = case 0 ? 1 of
0 -> 0
1 -> 1
v -> v
g = case [1..10] of
[] -> 0
(1:xs) -> 1 + length xs
(1:2:xs) -> 2 + length xs
_ -> 10
h [] = 0
h (1:xs) = 1 + length xs
h (1:2:xs) = 2 + length xs
-- f using flex case
ff zs = fcase zs of
(x:_) -> x
(_:y:_) -> y
-- f using rigid case
fr zs = case zs of
(x:_) -> x
(_:y:_) -> y
-- f using patterns (should equal flex case)
fp (x:_) = x
fp (_:y:_) = y
-- g using flex case
gf zs = fcase zs of
(x:_) | x > 0 -> x
(_:y:_) | y > 0 -> y
-- g using rigid case
gr zs = case zs of
(x:_) | x > 0 -> x
(_:y:_) | y > 0 -> y
-- g using patterns (should equal flex case)
gp (x:_) | x > 0 = x
gp (_:y:_) | y > 0 = y
------------------------------------------------------------------------------
--- An implementation of double-ended queues supporting access at both
--- ends in constant amortized time.
---
--- @author Bernd Brassel, Olaf Chitil, Michael Hanus, Sebastian Fischer
--- @version October 2006
------------------------------------------------------------------------------
module Dequeue(Queue,empty,isEmpty,deqHead,deqLast,cons,deqTail,snoc,deqInit,
listToDeq,deqToList,deqReverse,deqLength,rotate,
matchHead,matchLast)
where
--- The datatype of a queue.
data Queue a = S Int [a] Int [a]
--- The empty queue.
empty :: Queue _
empty = S 0 [] 0 []
--- Is the queue empty?
isEmpty :: Queue _ -> Bool
isEmpty (S lenf _ lenr _) = lenf+lenr==0
--- The first element of the queue.
deqHead :: Queue a -> a
deqHead (S lenf f _ r) = head (if lenf==0 then r else f)
--- The last element of the queue.
deqLast :: Queue a -> a
deqLast (S _ f lenr r) = head (if lenr==0 then f else r)
--- Inserts an element at the front of the queue.
cons :: a -> Queue a -> Queue a
cons x (S lenf f lenr r) = check (lenf+1) (x:f) lenr r
--- Removes an element at the front of the queue.
deqTail :: Queue a -> Queue a
deqTail (S _ [] _ _) = empty
deqTail (S lenf (_:fs) lenr r) = deqReverse (check lenr r (lenf-1) fs)
--- Inserts an element at the end of the queue.
snoc :: a -> Queue a -> Queue a
snoc x (S lenf f lenr r) = deqReverse (check (lenr+1) (x:r) lenf f)
--- Removes an element at the end of the queue.
deqInit :: Queue a -> Queue a
deqInit (S _ _ _ []) = empty
deqInit (S lenf f lenr (_:rs)) = check lenf f (lenr-1) rs
--- Reverses a double ended queue.
deqReverse :: Queue a -> Queue a
deqReverse (S lenf f lenr r) = S lenr r lenf f
check :: Int -> [a] -> Int -> [a] -> Queue a
check lenf f lenr r
| lenf<=3*lenr+1 = S lenf f lenr r
| otherwise = S lenf' f' lenr' r'
where
len = lenf+lenr
lenf' = len `div` 2
lenr' = len - lenf'
(f',rf') = splitAt lenf' f
r' = r++reverse rf'
--- Transforms a list to a double ended queue.
listToDeq :: [a] -> Queue a
listToDeq xs = check (length xs) xs 0 []
--- Transforms a double ended queue to a list.
deqToList :: Queue a -> [a]
deqToList (S _ xs _ ys) = xs ++ reverse ys
--- Returns the number of elements in the queue.
deqLength :: Queue _ -> Int
deqLength (S lenf _ lenr _) = lenf+lenr
--- Moves the first element to the end of the queue.
rotate :: Queue a -> Queue a
rotate q = snoc (deqHead q) (deqTail q)
--- Matches the front of a queue.
--- <code>matchHead q</code> is equivalent to
--- <code>if isEmpty q then Nothing else Just (deqHead q,deqTail q)</code>
--- but more efficient.
matchHead :: Queue a -> Maybe (a,Queue a)
matchHead (S _ [] _ []) = Nothing
matchHead (S _ [] _ [x]) = Just (x,empty)
matchHead (S lenf (x:xs) lenr r)
= Just (x,deqReverse (check lenr r (lenf-1) xs))
--- Matches the end of a queue.
--- <code>matchLast q</code> is equivalent to
--- <code>if isEmpty q then Nothing else Just (deqLast q,deqInit q)</code>
--- but more efficient.
matchLast :: Queue a -> Maybe (a,Queue a)
matchLast (S _ [] _ []) = Nothing
matchLast (S _ [x] _ []) = Just (x,empty)
matchLast (S lenf f lenr (x:xs)) = Just (x,check lenf f (lenr-1) xs)
f :: a -> a
f :: b -> b
f x = x
f :: c -> c
\ No newline at end of file
module ExportError (module Foo) where
notCase x = case x of
True -> False
True -> False
False -> True
v -> v
notP True = False
notP True = False
notP False = True
notP v = v
notFCase x = fcase x of
True -> False
True -> False
False -> True
v -> v
f (v@[] ++ v@(x:xs)) = x:xs ++ v
g (id ((:) x xs)) = x:xs
h (id (x:xs)) = x:xs
f = case () of
_ -> True
_ -> False
module ImportError where
import Prelude (foo, bar)
\ No newline at end of file
module Kindcheck where
data Foo a a = Foo a a
data Bar b b = Bar b b
f = \ x y -> x : y
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment