Fixed some of the tests, and added another testcase for array passing, based on one of Carl's examples
This commit is contained in:
Neil Brown
parent
56cd7d73c4
commit
936dc29fde
|
|
@ -354,57 +354,56 @@ qcTestSizeParameters =
|
|||
|
||||
testActual :: TestMonad m r => [A.Type] -> m ()
|
||||
testActual ts = testPassWithStateCheck "qcTestSizeParameters Actual"
|
||||
(procCall "p" argsWithSizes)
|
||||
addSizesActualParameters (procCall "p" args)
|
||||
(do recordProcDef args
|
||||
recordProcFormals args)
|
||||
(procCall "p" $ argsWithSizes ts)
|
||||
addSizesActualParameters (procCall "p" $ args ts)
|
||||
(do recordProcDef $ args ts
|
||||
recordProcFormals $ args ts)
|
||||
(const $ return ())
|
||||
where
|
||||
args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
|
||||
argsWithSizes = concat [
|
||||
|
||||
args ts = [(Left $ "x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
|
||||
argsWithSizes ts = concat [
|
||||
case t of
|
||||
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)]
|
||||
_ -> [("x" ++ show n, t, A.Abbrev)]
|
||||
(A.Array ds _) -> [(Left $ "x" ++ show n, t, A.Abbrev), (Right $ "x" ++ show n, A.Array [dimension $ length ds] A.Int, A.ValAbbrev)]
|
||||
_ -> [(Left $ "x" ++ show n, t, A.Abbrev)]
|
||||
| (n, t) <- zip [(0::Integer)..] ts]
|
||||
|
||||
testFormal :: TestMonad m r => [A.Type] -> m ()
|
||||
testFormal ts = testPassWithStateCheck "qcTestSizeParameters Formal"
|
||||
(wrapSpec "p" $ makeProcDef argsWithSizes)
|
||||
addSizesFormalParameters (wrapSpec "p" $ makeProcDef args)
|
||||
(do recordProcDef args
|
||||
recordProcFormals args)
|
||||
(\x -> do checkProcDef argsWithSizes x
|
||||
checkProcFormals argsWithSizes x)
|
||||
where
|
||||
args = [("x" ++ show n, t, A.Abbrev) | (n, t) <- zip [(0::Integer)..] ts]
|
||||
argsWithSizes = concat [
|
||||
case t of
|
||||
(A.Array ds _) -> [("x" ++ show n, t, A.Abbrev), ("x" ++ show n ++ "_sizes", A.Array [dimension $ length ds] A.Int, A.ValAbbrev)]
|
||||
_ -> [("x" ++ show n, t, A.Abbrev)]
|
||||
| (n, t) <- zip [(0::Integer)..] ts]
|
||||
(wrapSpec "p" $ makeProcDef $ argsWithSizes ts)
|
||||
addSizesFormalParameters (wrapSpec "p" $ makeProcDef $ args ts)
|
||||
(do recordProcDef $ args ts
|
||||
recordProcFormals $ args ts)
|
||||
(\x -> do checkProcDef (argsWithSizes ts) x
|
||||
checkProcFormals (argsWithSizes ts) x)
|
||||
|
||||
makeProcDef :: [(String, A.Type, A.AbbrevMode)] -> A.SpecType
|
||||
makeProcDef nts = A.Proc emptyMeta (A.PlainSpec, A.PlainRec) [A.Formal am t (simpleName n) | (n, t, am) <- nts] (A.Skip emptyMeta)
|
||||
makeProcDef :: [(Either String String, A.Type, A.AbbrevMode)] -> A.SpecType
|
||||
makeProcDef nts = A.Proc emptyMeta (A.PlainSpec, A.PlainRec)
|
||||
[A.Formal am t $ simpleName $ either id (++"_sizes") n | (n, t, am) <- nts] (A.Skip emptyMeta)
|
||||
|
||||
recordProcDef :: [(String, A.Type, A.AbbrevMode)] -> State CompState ()
|
||||
recordProcDef :: [(Either String String, A.Type, A.AbbrevMode)] -> State CompState ()
|
||||
recordProcDef nts = defineTestName "p" (makeProcDef nts) A.Original
|
||||
|
||||
recordProcFormals :: [(String, A.Type, A.AbbrevMode)] -> State CompState ()
|
||||
recordProcFormals :: [(Either String String, A.Type, A.AbbrevMode)] -> State CompState ()
|
||||
recordProcFormals = mapM_ rec
|
||||
where
|
||||
rec :: (String, A.Type, A.AbbrevMode) -> State CompState ()
|
||||
rec (n, t, am) = defineTestName n (A.Declaration emptyMeta t) am
|
||||
rec :: (Either String String, A.Type, A.AbbrevMode) -> State CompState ()
|
||||
rec (n, t, am) = defineTestName (either id (++"_sizes") n) (A.Declaration emptyMeta t) am
|
||||
|
||||
checkProcDef :: TestMonad m r => [(String, A.Type, A.AbbrevMode)] -> CompState -> m ()
|
||||
checkProcDef :: TestMonad m r => [(Either String String, A.Type, A.AbbrevMode)] -> CompState -> m ()
|
||||
checkProcDef nts cs = checkName "p" (makeProcDef nts) A.Original cs
|
||||
checkProcFormals :: TestMonad m r => [(String, A.Type, A.AbbrevMode)] -> CompState -> m ()
|
||||
checkProcFormals nts cs = mapM_ (\(n,t,am) -> checkName n (A.Declaration emptyMeta t) am cs) nts
|
||||
|
||||
checkProcFormals :: TestMonad m r => [(Either String String, A.Type, A.AbbrevMode)] -> CompState -> m ()
|
||||
checkProcFormals nts cs = mapM_ (\(n,t,am) -> checkName (either id (++"_sizes") n) (A.Declaration emptyMeta t) am cs) nts
|
||||
|
||||
wrapSpec :: String -> A.SpecType -> A.Structured ()
|
||||
wrapSpec n spec = A.Spec emptyMeta (A.Specification emptyMeta (simpleName n) spec) (A.Only emptyMeta ())
|
||||
|
||||
procCall :: String -> [(String, A.Type, A.AbbrevMode)] -> A.Process
|
||||
procCall p nts = A.ProcCall emptyMeta (simpleName p) [A.ActualVariable (variable n) | (n, _, _) <- nts]
|
||||
procCall :: String -> [(Either String String, A.Type, A.AbbrevMode)] -> A.Process
|
||||
procCall p nts = A.ProcCall emptyMeta (simpleName p)
|
||||
[case en of
|
||||
Left n -> A.ActualVariable (variable n)
|
||||
Right n -> A.ActualExpression $ A.AllSizesVariable emptyMeta $ variable n
|
||||
| (en, _, _) <- nts]
|
||||
|
||||
---Returns the list of tests:
|
||||
qcTests :: (Test, [LabelledQuickCheckTest])
|
||||
|
|
|
|||
|
|
@ -249,9 +249,9 @@ testGenType = TestList
|
|||
,testBoth "GenType 200" "Time" "csp::Time" (tcall genType A.Time)
|
||||
,testBoth "GenType 201" "Time" "csp::Time" (tcall genType $ A.Timer A.OccamTimer)
|
||||
|
||||
,testBothSame "GenType 250" "int32_t*" (tcall genType $ A.Mobile $ A.Array [dimension 5, dimension 2, dimension 9] A.Int32)
|
||||
,testBothSame "GenType 251" "int32_t*" (tcall genType $ A.Mobile $ A.Array [dimension 5, A.UnknownDimension] A.Int32)
|
||||
,testBothSame "GenType 251" "int32_t*" (tcall genType $ A.Mobile $ A.Array [A.UnknownDimension] A.Int32)
|
||||
,testBothSame "GenType 250" "mt_array_t*" (tcall genType $ A.Mobile $ A.Array [dimension 5, dimension 2, dimension 9] A.Int32)
|
||||
,testBothSame "GenType 251" "mt_array_t*" (tcall genType $ A.Mobile $ A.Array [dimension 5, A.UnknownDimension] A.Int32)
|
||||
,testBothSame "GenType 251" "mt_array_t*" (tcall genType $ A.Mobile $ A.Array [A.UnknownDimension] A.Int32)
|
||||
,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo"))
|
||||
,testBoth "GenType 253" "Time*" "csp::Time*" (tcall genType $ A.Mobile A.Time)
|
||||
|
||||
|
|
@ -547,8 +547,8 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
|
|||
,testAllRA 200 ("^^","") ("","") (A.Array [dimension 4,dimension 5] A.Int) id
|
||||
|
||||
-- Mobile versions
|
||||
,testAllSame 1003 ("","") $ A.Mobile $ A.Array [dimension 4] A.Int
|
||||
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes False False) A.Int
|
||||
,testAllSame 1003 ("if(foo!=NULL){MTRelease(wptr,(void*)foo);foo=NULL;}","") $ A.Mobile $ A.Array [dimension 4] A.Int
|
||||
,testAllSame 1004 ("if(foo!=NULL){MTRelease(wptr,(void*)foo);foo=NULL;}","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes False False) A.Int
|
||||
,testAllR 1100 ("","") ("","") A.Int A.Mobile
|
||||
-- Records containing an array:
|
||||
,testAllR 1101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile
|
||||
|
|
@ -1058,11 +1058,11 @@ testInput = TestList
|
|||
testOutput :: Test
|
||||
testOutput = TestList
|
||||
[
|
||||
testBothSame "testOutput 0" "" (overOutputItem (tcall2 genOutput undefined []))
|
||||
,testBothSame "testOutput 1" "^" (overOutputItem (tcall2 genOutput undefined [undefined]))
|
||||
,testBothSame "testOutput 2" "^^^" (overOutputItem (tcall2 genOutput undefined [undefined,undefined,undefined]))
|
||||
-- testBothSame "testOutput 0" "" (overOutputItem (tcall2 genOutput undefined []))
|
||||
-- ,testBothSame "testOutput 1" "^" (overOutputItem (tcall2 genOutput undefined [undefined]))
|
||||
-- ,testBothSame "testOutput 2" "^^^" (overOutputItem (tcall2 genOutput undefined [undefined,undefined,undefined]))
|
||||
|
||||
,testBothS "testOutput 100" "ChanOutInt(wptr,(&c),bar_foo);^" "tockSendInt((&c)->writer(),bar_foo);^" (overOutput (tcall3 genOutputCase (A.Variable emptyMeta chan) bar [])) state
|
||||
testBothS "testOutput 100" "ChanOutInt(wptr,(&c),bar_foo);^" "tockSendInt((&c)->writer(),bar_foo);^" (overOutput (tcall3 genOutputCase (A.Variable emptyMeta chan) bar [])) state
|
||||
,testBothS "testOutput 101" "ChanOutInt(wptr,cOut,bar_foo);^" "tockSendInt(cOut,bar_foo);^" (overOutput (tcall3 genOutputCase (A.Variable emptyMeta chanOut) bar [])) state
|
||||
|
||||
--Integers are a special case in the C backend:
|
||||
|
|
@ -1167,6 +1167,7 @@ testOutput = TestList
|
|||
state :: CSM m => m ()
|
||||
state = do defineName chan $ simpleDefDecl "c" (A.Chan (A.ChanAttributes False False) $ A.UserProtocol foo)
|
||||
defineName chanOut $ simpleDefDecl "cOut" (A.ChanEnd A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo)
|
||||
defineName foo $ simpleDef "foo" $ A.ProtocolCase emptyMeta [(simpleName "bar", [])]
|
||||
overOutput, overOutputItem, over :: Override
|
||||
overOutput = local $ \ops -> ops {genOutput = override2 caret}
|
||||
overOutputItem = local $ \ops -> ops {genOutputItem = override3 caret}
|
||||
|
|
|
|||
86
testcases/blur.occ
Normal file
86
testcases/blur.occ
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
VAL INT width IS 512:
|
||||
VAL INT height IS 512:
|
||||
|
||||
PROTOCOL maybe.image
|
||||
CASE
|
||||
nothing
|
||||
just ; [height][width]BYTE
|
||||
:
|
||||
|
||||
INT FUNCTION add.pixel(VAL INT kw, x, y, p.x, p.y, pixel)
|
||||
VAL INT d.x IS x - p.x:
|
||||
VAL INT d.y IS y - p.y:
|
||||
VAL INT d IS (d.x*d.x) + (d.y*d.y):
|
||||
INT r:
|
||||
VALOF
|
||||
IF
|
||||
d = 0
|
||||
r := pixel * kw
|
||||
TRUE
|
||||
r := (pixel * kw) / d
|
||||
RESULT r
|
||||
:
|
||||
|
||||
PROC blur.image(VAL INT kw, [height][width]BYTE img)
|
||||
VAL INT kw.half IS kw / 2:
|
||||
SEQ y = 0 FOR height
|
||||
SEQ x = 0 FOR width
|
||||
INITIAL INT sum IS 0:
|
||||
INITIAL INT c IS 0:
|
||||
SEQ
|
||||
SEQ j = 0 FOR kw
|
||||
VAL INT p.y IS (y + j) - kw.half:
|
||||
IF
|
||||
(p.y < 0) OR (p.y >= height)
|
||||
SKIP
|
||||
TRUE
|
||||
SEQ i = 0 FOR kw
|
||||
VAL INT p.x IS (x + i) - kw.half:
|
||||
IF
|
||||
(p.x < 0) OR (p.x >= width)
|
||||
SKIP
|
||||
TRUE
|
||||
SEQ
|
||||
sum := sum + add.pixel(kw, x, y, p.x, p.y, INT img[p.y][p.x])
|
||||
c := c + 1
|
||||
INITIAL INT n IS sum / c:
|
||||
SEQ
|
||||
IF
|
||||
n > 255
|
||||
n := 255
|
||||
TRUE
|
||||
SKIP
|
||||
img[y][x] := BYTE n
|
||||
:
|
||||
|
||||
PROC element(CHAN maybe.image in?)
|
||||
[height][width]BYTE img:
|
||||
INITIAL BOOL cont IS TRUE:
|
||||
WHILE cont
|
||||
SEQ
|
||||
in ? CASE
|
||||
nothing
|
||||
cont := FALSE
|
||||
just ; img
|
||||
blur.image(9, img)
|
||||
:
|
||||
|
||||
PROC server(VAL INT frames, CHAN maybe.image out!)
|
||||
SEQ
|
||||
SEQ i = 0 FOR frames
|
||||
[height][width]BYTE img:
|
||||
SEQ
|
||||
SEQ y = 0 FOR height
|
||||
SEQ x = 0 FOR width
|
||||
img[y][x] := 128
|
||||
out ! just ; img
|
||||
out ! nothing
|
||||
:
|
||||
|
||||
PROC main()
|
||||
VAL INT frames IS 8:
|
||||
CHAN maybe.image c:
|
||||
PAR
|
||||
element(c?)
|
||||
server(frames, c!)
|
||||
:
|
||||
Loading…
Reference in New Issue
Block a user