c8b724d2be
I also added the import list to all the Data.Generics imports in the tests (as I did for the other modules recently)
643 lines
29 KiB
Haskell
643 lines
29 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2008 University of Kent
|
|
|
|
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, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- #ignore-exports
|
|
|
|
-- | Tests for 'OccamTypes'.
|
|
module OccamTypesTest (vioTests) where
|
|
|
|
import Control.Monad.State
|
|
import Data.Generics (Data)
|
|
import Test.HUnit hiding (State)
|
|
|
|
import qualified AST as A
|
|
import CompState
|
|
import Metadata
|
|
import qualified OccamTypes
|
|
import Pass
|
|
import TestHarness
|
|
import TestUtils
|
|
import Traversal
|
|
|
|
m :: Meta
|
|
m = emptyMeta
|
|
|
|
-- | Initial state for the tests.
|
|
startState :: State CompState ()
|
|
startState
|
|
= do defineConst "constInt" A.Int (intLiteral 2)
|
|
defineConst "constInts" intsT (A.Literal m intsT arrayLit)
|
|
defineVariable "varInt" A.Int
|
|
defineVariable "varByte" A.Byte
|
|
defineVariable "varReal" A.Real32
|
|
defineVariable "varInts" (A.Array [A.UnknownDimension] A.Int)
|
|
defineVariable "varBytes" (A.Array [A.UnknownDimension] A.Byte)
|
|
defineUserDataType "MYINT" A.Int
|
|
defineUserDataType "MY2INT" (A.Array [dimension 2] A.Int)
|
|
defineRecordType "COORD2" [("x", A.Int), ("y", A.Int)]
|
|
defineRecordType "COORD3" [("x", A.Real32), ("y", A.Real32),
|
|
("z", A.Real32)]
|
|
defineChannel "chanInt" chanIntT
|
|
defineChannel "chansInt" (A.Array [A.UnknownDimension] chanIntT)
|
|
defineVariable "mobileInt" (A.Mobile A.Int)
|
|
defineFunction "function0" [A.Int] []
|
|
defineFunction "function1" [A.Int] [("x", A.Int)]
|
|
defineFunction "function2" [A.Int] [("x", A.Int), ("y", A.Int)]
|
|
defineFunction "function22" [A.Int, A.Int]
|
|
[("x", A.Int), ("y", A.Int)]
|
|
defineProtocol "countedInts" $ [A.Counted A.Int intsT]
|
|
defineChannel "chanCountedInts" countedIntsT
|
|
defineProtocol "iir" $ [A.Int, A.Int, A.Real32]
|
|
defineChannel "chanIIR" iirT
|
|
defineProtocolCase "caseProto" $ [ (simpleName "one", [A.Int])
|
|
, (simpleName "two", [A.Real32])
|
|
, (simpleName "three", [])
|
|
]
|
|
defineChannel "chanCaseProto" caseProtoT
|
|
defineTimer "tim" $ A.Timer A.OccamTimer
|
|
defineProc "proc0" []
|
|
defineProc "proc1" [("x", A.ValAbbrev, A.Int)]
|
|
defineProc "proc2" [("x", A.ValAbbrev, A.Int), ("y", A.Abbrev, A.Int)]
|
|
where
|
|
intsT = A.Array [A.UnknownDimension] A.Int
|
|
arrayLit = A.ArrayListLiteral m $ A.Several m []
|
|
chanT t = A.Chan (A.ChanAttributes A.Unshared A.Unshared) t
|
|
chanIntT = chanT A.Int
|
|
countedIntsT = chanT $ A.UserProtocol (simpleName "countedInts")
|
|
iirT = chanT $ A.UserProtocol (simpleName "iir")
|
|
caseProtoT = chanT $ A.UserProtocol (simpleName "caseProto")
|
|
|
|
-- | Test the typechecker.
|
|
testOccamTypes :: Test
|
|
testOccamTypes = TestList
|
|
[
|
|
--{{{ expressions
|
|
|
|
-- Subscript expressions
|
|
testOK 0 $ subex $ A.Subscript m A.NoCheck intE
|
|
, testFail 1 $ subex $ A.Subscript m A.NoCheck byteE
|
|
, testOK 2 $ subex $ A.SubscriptFromFor m A.NoCheck intE intE
|
|
, testFail 3 $ subex $ A.SubscriptFromFor m A.NoCheck byteE byteE
|
|
, testOK 4 $ subex $ A.SubscriptFrom m A.NoCheck intE
|
|
, testFail 5 $ subex $ A.SubscriptFrom m A.NoCheck byteE
|
|
, testOK 6 $ subex $ A.SubscriptFor m A.NoCheck intE
|
|
, testFail 7 $ subex $ A.SubscriptFor m A.NoCheck byteE
|
|
|
|
-- Trivial literals
|
|
, testOK 20 $ intE
|
|
, testOK 21 $ byteE
|
|
|
|
-- Array literals
|
|
, testOK 30 $ A.Literal m twoIntsT twoInts
|
|
, testFail 31 $ A.Literal m threeIntsT twoInts
|
|
, testFail 32 $ A.Literal m twoBytesT twoInts
|
|
, testFail 33 $ A.Literal m A.Int twoInts
|
|
, testFail 34 $ A.Literal m twoTwoIntsT twoInts
|
|
, testOK 35 $ A.Literal m myTwoIntsT twoInts
|
|
, testFail 36 $ A.Literal m myIntT twoInts
|
|
|
|
-- Record literals
|
|
, testFail 40 $ A.Literal m coord2T twoInts
|
|
, testOK 41 $ A.Literal m coord2T coord2
|
|
, testFail 42 $ A.Literal m coord2T coord3
|
|
, testOK 43 $ A.Literal m coord3T coord3
|
|
, testFail 44 $ A.Literal m coord3T coord2
|
|
, testFail 45 $ A.Literal m A.Int coord2
|
|
, testFail 46 $ A.Literal m twoIntsT coord2
|
|
, testFail 47 $ A.Literal m myTwoIntsT coord2
|
|
|
|
-- Variables
|
|
, testOK 50 $ intV
|
|
, testOK 51 $ bytesV
|
|
, testOK 52 $ A.DirectedVariable m A.DirInput intC
|
|
, testFail 53 $ A.DirectedVariable m A.DirInput intV
|
|
, testOK 54 $ A.DerefVariable m mobileIntV
|
|
, testFail 55 $ A.DerefVariable m intC
|
|
|
|
-- Miscellaneous expressions
|
|
, testOK 150 $ A.MostPos m A.Int
|
|
, testFail 151 $ A.MostPos m twoIntsT
|
|
, testOK 152 $ A.MostNeg m A.Int
|
|
, testFail 153 $ A.MostNeg m twoIntsT
|
|
, testOK 154 $ A.SizeType m twoIntsT
|
|
, testFail 155 $ A.SizeType m A.Int
|
|
, testOK 156 $ A.SizeExpr m twoIntsE
|
|
, testFail 157 $ A.SizeExpr m intE
|
|
, testOK 158 $ A.SizeExpr m twoTwoIntsE
|
|
, testOK 159 $ A.SizeExpr m (sub0E twoTwoIntsE)
|
|
, testFail 160 $ A.SizeExpr m (sub0E (sub0E twoTwoIntsE))
|
|
, testFail 161 $ A.SizeExpr m (sub0E intE)
|
|
, testOK 162 $ A.ExprVariable m $ A.VariableSizes m intsV
|
|
, testFail 163 $ A.ExprVariable m $ A.VariableSizes m byteV
|
|
, testOK 164 $ A.ExprVariable m intV
|
|
, testOK 165 $ intE
|
|
, testOK 166 $ boolLiteral True
|
|
, testOK 167 $ A.IntrinsicFunctionCall m "SQRT" [realE]
|
|
, testFail 168 $ A.IntrinsicFunctionCall m "SQRT" [intE]
|
|
, testFail 169 $ A.IntrinsicFunctionCall m "SQRT" [realE, intE]
|
|
, testOK 170 $ subxE coord2E
|
|
, testFail 171 $ subxE twoTwoIntsE
|
|
, testFail 172 $ subxE intE
|
|
, testFail 173 $ A.SubscriptedExpr m (A.SubscriptField m function0) coord2E
|
|
, testOK 174 $ A.OffsetOf m coord2T (simpleName "x")
|
|
, testFail 175 $ A.OffsetOf m coord2T function0
|
|
, testFail 176 $ A.OffsetOf m A.Int (simpleName "x")
|
|
|
|
-- Conversions
|
|
, testOK 200 $ A.Conversion m A.Round A.Int realE
|
|
, testOK 201 $ A.Conversion m A.Round A.Real32 intE
|
|
, testFail 202 $ A.Conversion m A.Round A.Real32 twoIntsE
|
|
, testFail 203 $ A.Conversion m A.Round twoIntsT realE
|
|
|
|
-- Function calls
|
|
, testOK 220 $ A.FunctionCall m function0 []
|
|
, testOK 221 $ A.FunctionCall m function1 [intE]
|
|
, testOK 222 $ A.FunctionCall m function2 [intE, intE]
|
|
, testFail 223 $ A.FunctionCall m function22 [intE, intE]
|
|
, testFail 224 $ A.FunctionCall m function0 [intE]
|
|
, testFail 225 $ A.FunctionCall m function1 [intE, intE]
|
|
, testFail 226 $ A.FunctionCall m function2 [intE]
|
|
, testFail 227 $ A.FunctionCall m function2 [intE, intE, intE]
|
|
, testFail 228 $ A.FunctionCall m (simpleName "someInt") [intE]
|
|
, testFail 229 $ A.FunctionCall m function1 [realE]
|
|
, testFail 230 $ A.FunctionCall m function2 [intE, realE]
|
|
, testFail 231 $ A.FunctionCall m function2 [twoIntsE, intE]
|
|
, testOK 232 $ A.FunctionCall m function1 [sub0E twoIntsE]
|
|
|
|
-- Mobile allocations
|
|
, testOK 250 $ A.AllocMobile m (A.Mobile A.Int) (Just intE)
|
|
, testOK 251 $ A.AllocMobile m (A.Mobile A.Int) Nothing
|
|
, testFail 252 $ A.AllocMobile m (A.Mobile A.Int) (Just realE)
|
|
, testFail 253 $ A.AllocMobile m (A.Mobile A.Int) (Just realE)
|
|
, testOK 254 $ A.AllocMobile m (A.Mobile A.Real32) (Just realE)
|
|
, testOK 254 $ A.AllocMobile m (A.Mobile twoIntsT) (Just twoIntsE)
|
|
, testFail 255 $ A.AllocMobile m (A.Mobile unknownIntsT) (Just twoIntsE)
|
|
, testFail 256 $ A.AllocMobile m (A.Mobile unknownIntsT) Nothing
|
|
|
|
--}}}
|
|
--{{{ processes
|
|
|
|
-- Inputs
|
|
, testOK 1000 $ inputSimple countedIntsCin [A.InCounted m intV intsV]
|
|
, testFail 1001 $ inputSimple countedIntsCin [A.InCounted m realV intsV]
|
|
, testFail 1002 $ inputSimple countedIntsCin [A.InCounted m intV intV]
|
|
, testFail 1003 $ inputSimple countedIntsCin [A.InCounted m constIntV intsV]
|
|
, testFail 1004 $ inputSimple countedIntsCin [A.InCounted m intV constIntsV]
|
|
, testFail 1005 $ inputSimple countedIntsCin [A.InCounted m intV intsC]
|
|
, testOK 1010 $ inputSimple intCin [inv intV]
|
|
, testFail 1011 $ inputSimple intCin [inv constIntV]
|
|
, testFail 1012 $ inputSimple intCin [inv intC]
|
|
, testFail 1013 $ inputSimple intV [inv intV]
|
|
, testFail 1014 $ inputSimple intV []
|
|
, testFail 1015 $ inputSimple intV [inv intV, inv intV]
|
|
, testFail 1016 $ inputSimple tim [inv intV]
|
|
, testFail 1017 $ inputSimple intC [inv intV]
|
|
, testOK 1020 $ inputSimple iirCin [inv intV, inv intV, inv realV]
|
|
, testFail 1021 $ inputSimple iirCin [inv intV, inv realV, inv intV]
|
|
, testFail 1022 $ inputSimple iirCin [inv realV, inv intV, inv intV]
|
|
, testFail 1023 $ inputSimple iirCin [inv intV, inv intV]
|
|
, testFail 1024 $ inputSimple iirCin [inv intV, inv intV, inv realV, inv intV]
|
|
, testOK 1030 $ inputCase caseCin [ vari "one" [inv intV]
|
|
, vari "two" [inv realV]
|
|
, vari "three" []
|
|
]
|
|
, testFail 1031 $ inputCase caseCin [ vari "one" [inv realV]
|
|
, vari "two" [inv realV]
|
|
, vari "three" []
|
|
]
|
|
, testFail 1032 $ inputCase caseCin [ vari "one" [inv intV]
|
|
, vari "two" [inv intV]
|
|
, vari "three" []
|
|
]
|
|
, testFail 1033 $ inputCase caseCin [ vari "one" [inv intV]
|
|
, vari "herring" [inv realV]
|
|
, vari "three" []
|
|
]
|
|
, testFail 1034 $ inputCase caseCin [ vari "one" [inv intV, inv realV]
|
|
, vari "two" [inv realV]
|
|
, vari "three" []
|
|
]
|
|
, testFail 1035 $ inputCase caseCin [ vari "one" []
|
|
, vari "two" []
|
|
, vari "three" []
|
|
]
|
|
, testFail 1036 $ inputCase caseC [ vari "one" [inv intV]
|
|
, vari "two" [inv realV]
|
|
, vari "three" []
|
|
]
|
|
|
|
|
|
-- Outputs
|
|
, testOK 1100 $ outputSimple countedIntsCout [A.OutCounted m intE twoIntsE]
|
|
, testFail 1101 $ outputSimple countedIntsCout [A.OutCounted m realE twoIntsE]
|
|
, testFail 1102 $ outputSimple countedIntsCout [A.OutCounted m intE intE]
|
|
, testFail 1103 $ outputSimple countedIntsC [A.OutCounted m intE twoIntsE]
|
|
, testOK 1110 $ outputSimple intCout [oute intE]
|
|
, testFail 1111 $ outputSimple intCout [oute intCE]
|
|
, testFail 1112 $ outputSimple intV [oute intE]
|
|
, testFail 1113 $ outputSimple tim [oute intE]
|
|
, testFail 1114 $ outputSimple intC [oute intE]
|
|
, testOK 1120 $ outputSimple iirCout [oute intE, oute intE, oute realE]
|
|
, testFail 1121 $ outputSimple iirCout [oute intE, oute realE, oute intE]
|
|
, testFail 1122 $ outputSimple iirCout [oute realE, oute intE, oute intE]
|
|
, testFail 1123 $ outputSimple iirCout [oute intE, oute intE]
|
|
, testFail 1124 $ outputSimple iirCout [oute intE, oute intE, oute realE,
|
|
oute intE]
|
|
, testFail 1125 $ outputSimple iirC [oute intE, oute intE, oute realE]
|
|
, testOK 1130 $ outputCase caseCout "one" [oute intE]
|
|
, testOK 1131 $ outputCase caseCout "two" [oute realE]
|
|
, testOK 1132 $ outputCase caseCout "three" []
|
|
, testFail 1133 $ outputCase caseCout "three" [oute intE]
|
|
, testFail 1134 $ outputCase caseCout "two" [oute realE, oute intE]
|
|
, testFail 1135 $ outputCase caseCout "two" []
|
|
, testFail 1136 $ outputCase caseCout "two" [oute intE]
|
|
, testFail 1137 $ outputCase caseCout "herring" [oute intE]
|
|
, testFail 1138 $ outputCase caseC "one" [oute intE]
|
|
|
|
-- Timer operations
|
|
, testOK 1180 $ A.Input m tim $ A.InputTimerRead m $ inv intV
|
|
, testOK 1181 $ A.Input m tim $ A.InputTimerAfter m intE
|
|
, testOK 1182 $ A.Input m tim $ A.InputTimerFor m intE
|
|
, testFail 1183 $ A.Input m tim $ A.InputTimerRead m $ inv realV
|
|
, testFail 1184 $ A.Input m caseC $ A.InputTimerRead m $ inv intV
|
|
, testFail 1185 $ A.Input m tim $ A.InputTimerAfter m realE
|
|
, testFail 1186 $ A.Input m tim $ A.InputTimerFor m realE
|
|
|
|
-- Replicators
|
|
, testOK 1200 $ testRep i $ A.For m intE intE intE
|
|
, testFail 1201 $ testRep i $ A.For m realE intE intE
|
|
, testFail 1202 $ testRep i $ A.For m intE realE intE
|
|
, testOK 1203 $ testRep i $ A.ForEach m twoIntsE
|
|
, testFail 1205 $ testRep i $ A.ForEach m intE
|
|
, testFail 1206 $ testRep i $ A.For m intE intE realE
|
|
|
|
-- Choices
|
|
, testOK 1300 $ testChoice $ A.Choice m boolE skip
|
|
, testFail 1301 $ testChoice $ A.Choice m intE skip
|
|
|
|
-- Options
|
|
, testOK 1320 $ testOption intE $ A.Option m [] skip
|
|
, testOK 1321 $ testOption intE $ A.Option m [intE] skip
|
|
, testOK 1322 $ testOption intE $ A.Option m [intE, intE] skip
|
|
, testFail 1323 $ testOption realE $ A.Option m [realE] skip
|
|
, testFail 1324 $ testOption twoIntsE $ A.Option m [twoIntsE] skip
|
|
, testOK 1325 $ testOption boolE $ A.Option m [boolE] skip
|
|
, testFail 1326 $ testOption boolE $ A.Option m [intE] skip
|
|
, testFail 1327 $ testOption boolE $ A.Option m [boolE, intE] skip
|
|
|
|
-- Assignment
|
|
, testOK 1400 $ A.Assign m [intV] $ A.ExpressionList m [intE]
|
|
, testOK 1401 $ A.Assign m [intV, intV] $ A.ExpressionList m [intE, intE]
|
|
, testFail 1402 $ A.Assign m [intV] $ A.ExpressionList m [realE]
|
|
, testFail 1403 $ A.Assign m [intV, intV] $ A.ExpressionList m [intE]
|
|
, testFail 1404 $ A.Assign m [intV] $ A.ExpressionList m [intE, intE]
|
|
, testOK 1410 $ A.Assign m [intV, intV]
|
|
$ A.FunctionCallList m function22 [intE, intE]
|
|
, testFail 1411 $ A.Assign m [intV]
|
|
$ A.FunctionCallList m function22 [intE, intE]
|
|
, testFail 1412 $ A.Assign m [intV, intV, intV]
|
|
$ A.FunctionCallList m function22 [intE, intE]
|
|
, testFail 1413 $ A.Assign m [intV, realV]
|
|
$ A.FunctionCallList m function22 [intE, intE]
|
|
, testFail 1414 $ A.Assign m [intV, realV]
|
|
$ A.FunctionCallList m function22 [intE, realE]
|
|
, testFail 1415 $ A.Assign m [intV, realV]
|
|
$ A.FunctionCallList m function22 [realE]
|
|
|
|
-- Alt
|
|
, testOK 1500 $ testAlt $ A.Alternative m true intCin (insim [inv intV]) skip
|
|
, testOK 1501 $ testAlt $ A.Alternative m true tim
|
|
(A.InputTimerAfter m intE) skip
|
|
, testOK 1502 $ testAlt $ A.Alternative m boolE intCin
|
|
(insim [inv intV]) skip
|
|
, testOK 1503 $ testAlt $ A.AlternativeSkip m boolE skip
|
|
, testFail 1504 $ testAlt $ A.Alternative m true intCin (insim [inv realV]) skip
|
|
, testFail 1505 $ testAlt $ A.Alternative m true tim
|
|
(A.InputTimerRead m $ inv intV)
|
|
skip
|
|
, testFail 1506 $ testAlt $ A.Alternative m intE intCin
|
|
(insim [inv intV]) skip
|
|
, testFail 1507 $ testAlt $ A.AlternativeSkip m intE skip
|
|
|
|
-- Proc calls
|
|
, testOK 1600 $ proccall "proc0" []
|
|
, testOK 1601 $ proccall "proc1" [A.ActualExpression intE]
|
|
, testOK 1602 $ proccall "proc2" [A.ActualExpression intE,
|
|
A.ActualVariable intV]
|
|
, testFail 1603 $ proccall "proc0" [A.ActualExpression intE]
|
|
, testFail 1604 $ proccall "proc1" [A.ActualExpression realE]
|
|
, testFail 1605 $ proccall "proc1" [A.ActualExpression intE,
|
|
A.ActualExpression intE]
|
|
, testFail 1606 $ proccall "herring" []
|
|
|
|
-- Miscellaneous processes
|
|
, testOK 1900 $ A.ClearMobile m mobileIntV
|
|
, testFail 1901 $ A.ClearMobile m intV
|
|
, testOK 1902 $ A.Skip m
|
|
, testOK 1903 $ A.Stop m
|
|
, testOK 1904 $ A.While m boolE skip
|
|
, testFail 1905 $ A.While m intE skip
|
|
, testOK 1906 $ A.Par m A.PlainPar sskip
|
|
, testOK 1907 $ A.Processor m intE skip
|
|
, testFail 1908 $ A.Processor m realE skip
|
|
, testOK 1909 $ A.IntrinsicProcCall m "RESCHEDULE" []
|
|
, testOK 1910 $ A.IntrinsicProcCall m "ASSERT"
|
|
[A.ActualExpression boolE]
|
|
, testFail 1911 $ A.IntrinsicProcCall m "ASSERT"
|
|
[A.ActualExpression intE]
|
|
, testFail 1912 $ A.IntrinsicProcCall m "ASSERT" []
|
|
, testFail 1913 $ A.IntrinsicProcCall m "RESCHEDULE"
|
|
[A.ActualExpression boolE]
|
|
, testFail 1914 $ A.IntrinsicProcCall m "HERRING" []
|
|
|
|
--}}}
|
|
--{{{ specifications
|
|
|
|
-- Place
|
|
, testOK 2000 $ A.Place m intE
|
|
, testFail 2001 $ A.Place m twoIntsE
|
|
|
|
-- Declaration
|
|
, testOK 2010 $ A.Declaration m A.Int
|
|
, testOK 2011 $ A.Declaration m twoIntsT
|
|
|
|
-- Is
|
|
, testOK 2020 $ A.Is m A.Abbrev A.Int $ A.ActualVariable intV
|
|
, testFail 2021 $ A.Is m A.ValAbbrev A.Int $ A.ActualVariable intV
|
|
, testFail 2022 $ A.Is m A.Original A.Int $ A.ActualVariable intV
|
|
, testFail 2023 $ A.Is m A.Abbrev A.Real32 $ A.ActualVariable intV
|
|
, testOK 2024 $ A.Is m A.Abbrev chanIntT $ A.ActualVariable intC
|
|
, testFail 2025 $ A.Is m A.ValAbbrev chanIntT $ A.ActualVariable intC
|
|
, testOK 2026 $ A.Is m A.Abbrev (A.Timer A.OccamTimer) $ A.ActualVariable tim
|
|
, testFail 2027 $ A.Is m A.ValAbbrev (A.Timer A.OccamTimer) $ A.ActualVariable tim
|
|
|
|
-- IsExpr
|
|
, testOK 2030 $ A.Is m A.ValAbbrev A.Int $ A.ActualExpression intE
|
|
, testFail 2031 $ A.Is m A.Abbrev A.Int $ A.ActualExpression intE
|
|
, testFail 2032 $ A.Is m A.Original A.Int $ A.ActualExpression intE
|
|
, testFail 2033 $ A.Is m A.ValAbbrev A.Real32 $ A.ActualExpression intE
|
|
|
|
-- IsChannelArray
|
|
, testOK 2040 $ A.Is m A.Abbrev chansIntT $ A.ActualChannelArray [intC, intC]
|
|
, testOK 2041 $ A.Is m A.Abbrev uchansIntT $ A.ActualChannelArray [intC, intC]
|
|
, testOK 2042 $ A.Is m A.Abbrev uchansIntT $ A.ActualChannelArray []
|
|
, testFail 2043 $ A.Is m A.Abbrev chansIntT $ A.ActualChannelArray [intC]
|
|
, testFail 2044 $ A.Is m A.Abbrev chansIntT $ A.ActualChannelArray [iirC, intC]
|
|
, testFail 2045 $ A.Is m A.Abbrev chansIntT $ A.ActualChannelArray [intC, intC, intC]
|
|
, testFail 2046 $ A.Is m A.Abbrev chansIntT $ A.ActualChannelArray [intV, intV]
|
|
|
|
-- DataType
|
|
, testOK 2050 $ A.DataType m A.Int
|
|
, testOK 2051 $ A.DataType m twoIntsT
|
|
, testOK 2052 $ A.DataType m myTwoIntsT
|
|
, testFail 2053 $ A.DataType m chanIntT
|
|
, testFail 2054 $ A.DataType m $ A.Timer A.OccamTimer
|
|
|
|
-- RecordType
|
|
, testOK 2060 $ A.RecordType m packed []
|
|
, testOK 2061 $ A.RecordType m notPacked []
|
|
, testOK 2062 $ A.RecordType m notPacked [ (simpleName "x", A.Int)
|
|
, (simpleName "y", A.Int)
|
|
, (simpleName "z", A.Int)
|
|
]
|
|
, testFail 2063 $ A.RecordType m notPacked [(simpleName "c", chanIntT)]
|
|
, testOK 2064 $ A.RecordType m notPacked [(simpleName "c", A.Mobile A.Int)]
|
|
, testFail 2065 $ A.RecordType m notPacked [ (simpleName "x", A.Int)
|
|
, (simpleName "x", A.Real32)
|
|
]
|
|
|
|
-- Protocol
|
|
, testOK 2070 $ A.Protocol m [A.Int]
|
|
, testOK 2071 $ A.Protocol m [A.Int, A.Real32, twoIntsT]
|
|
, testOK 2072 $ A.Protocol m [A.Mobile A.Int]
|
|
, testFail 2073 $ A.Protocol m []
|
|
, testFail 2074 $ A.Protocol m [chanIntT]
|
|
, testOK 2075 $ A.Protocol m [A.Counted A.Int unknownIntsT]
|
|
, testFail 2076 $ A.Protocol m [A.Counted A.Real32 unknownIntsT]
|
|
, testFail 2077 $ A.Protocol m [A.Counted A.Int A.Int]
|
|
, testFail 2078 $ A.Protocol m [A.Counted A.Int twoIntsT]
|
|
|
|
, testOK 2080 $ A.ProtocolCase m [ (simpleName "one", [A.Int])
|
|
, (simpleName "two", [A.Real32])
|
|
, (simpleName "three", [])
|
|
]
|
|
, testFail 2081 $ A.ProtocolCase m [ (simpleName "one", [A.Int])
|
|
, (simpleName "one", [A.Real32])
|
|
]
|
|
|
|
-- Proc
|
|
, testOK 2090 $ A.Proc m (A.PlainSpec, A.PlainRec) [] jskip
|
|
, testOK 2091 $ A.Proc m (A.InlineSpec, A.PlainRec) [] jskip
|
|
, testOK 2092 $ A.Proc m (A.PlainSpec, A.PlainRec)
|
|
[ A.Formal A.Abbrev A.Int (simpleName "x")
|
|
, A.Formal A.ValAbbrev A.Int (simpleName "y")
|
|
, A.Formal A.Abbrev chanIntT (simpleName "c")
|
|
]
|
|
jskip
|
|
, testFail 2093 $ A.Proc m (A.PlainSpec, A.PlainRec)
|
|
[ A.Formal A.Original A.Int (simpleName "x")
|
|
]
|
|
jskip
|
|
|
|
-- Function
|
|
, testOK 2100 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnOne
|
|
, testOK 2110 $ A.Function m (A.InlineSpec, A.PlainRec) [A.Int] [] returnOne
|
|
, testFail 2120 $ A.Function m (A.PlainSpec, A.PlainRec) [] [] returnNone
|
|
, testOK 2130 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
|
|
[ A.Formal A.ValAbbrev A.Int (simpleName "x")
|
|
, A.Formal A.ValAbbrev A.Bool (simpleName "b")
|
|
, A.Formal A.ValAbbrev A.Int (simpleName "q")
|
|
]
|
|
returnOne
|
|
, testFail 2140 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
|
|
[A.Formal A.Abbrev A.Int (simpleName "x")]
|
|
returnOne
|
|
, testFail 2150 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
|
|
[A.Formal A.ValAbbrev chanIntT (simpleName "c")]
|
|
returnOne
|
|
, testFail 2160 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnNone
|
|
, testFail 2170 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnTwo
|
|
|
|
--}}}
|
|
--{{{ retyping
|
|
|
|
-- Definitely OK at compile time
|
|
, testOK 3000 $ retypesV A.Int intV
|
|
, testOK 3001 $ retypesE A.Int intE
|
|
, testOK 3002 $ retypesV A.Byte byteV
|
|
, testOK 3003 $ retypesE A.Byte byteE
|
|
, testOK 3004 $ retypesV known1 intV
|
|
, testOK 3005 $ retypesV known2 intV
|
|
, testOK 3006 $ retypesV both intV
|
|
, testOK 3007 $ retypesV unknown1 intV
|
|
|
|
-- Definitely wrong at compile time
|
|
, testFail 3100 $ retypesV A.Byte intV
|
|
, testFail 3101 $ retypesV A.Int byteV
|
|
, testFail 3102 $ retypesV unknown2 intV
|
|
, testFail 3103 $ retypesV unknown2 intsV
|
|
, testFail 3104 $ retypesV A.Byte intsV
|
|
|
|
-- Can't tell; need a runtime check
|
|
, testOK 3200 $ retypesV unknown1 intsV
|
|
, testOK 3201 $ retypesV A.Int intsV
|
|
, testOK 3202 $ retypesV known2 intsV
|
|
, testOK 3203 $ retypesV unknown1 bytesV
|
|
|
|
--}}}
|
|
]
|
|
where
|
|
testOK :: (PolyplateSpine a (OneOpQ (PassM ()) A.Variable) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Expression) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.SpecType) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Process) () (PassM ())
|
|
,Show a, Data a) => Int -> a -> Test
|
|
testOK n orig
|
|
= TestCase $ testPass ("testOccamTypes " ++ show n)
|
|
orig OccamTypes.checkTypes orig
|
|
startState
|
|
|
|
testFail :: (PolyplateSpine a (OneOpQ (PassM ()) A.Variable) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Expression) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.SpecType) () (PassM ())
|
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Process) () (PassM ())
|
|
,Show a, Data a) => Int -> a -> Test
|
|
testFail n orig
|
|
= TestCase $ testPassShouldFail ("testOccamTypes " ++ show n)
|
|
OccamTypes.checkTypes orig
|
|
startState
|
|
|
|
--{{{ expression fragments
|
|
|
|
true = A.True emptyMeta
|
|
subex sub = A.SubscriptedExpr m sub twoIntsE
|
|
intV = variable "varInt"
|
|
intE = intLiteral 42
|
|
realV = variable "varReal"
|
|
realE = A.Literal m A.Real32 $ A.RealLiteral m "3.14159"
|
|
byteV = variable "varByte"
|
|
byteE = byteLiteral 42
|
|
intsV = variable "varInts"
|
|
bytesV = variable "varBytes"
|
|
constIntV = variable "constInt"
|
|
constIntsV = variable "constInts"
|
|
boolE = boolLiteral True
|
|
unknownIntsT = A.Array [A.UnknownDimension] A.Int
|
|
twoIntsT = A.Array [dimension 2] A.Int
|
|
twoTwoIntsT = A.Array [dimension 2, dimension 2] A.Int
|
|
twoBytesT = A.Array [dimension 2] A.Byte
|
|
threeIntsT = A.Array [dimension 3] A.Int
|
|
ae = A.Only m intE
|
|
twoInts = A.ArrayListLiteral m $ A.Several m [ae, ae]
|
|
twoIntsE = A.Literal m twoIntsT twoInts
|
|
twoTwoInts = A.ArrayListLiteral m $ A.Several m
|
|
[A.Several m [ae, ae],
|
|
A.Several m [ae, ae]]
|
|
twoTwoIntsE = A.Literal m twoTwoIntsT twoTwoInts
|
|
myIntT = A.UserDataType (simpleName "MYINT")
|
|
myTwoIntsT = A.UserDataType (simpleName "MY2INT")
|
|
coord2T = A.Record (simpleName "COORD2")
|
|
coord2 = A.RecordLiteral m [intE, intE]
|
|
coord2E = A.Literal m coord2T coord2
|
|
coord3T = A.Record (simpleName "COORD3")
|
|
coord3 = A.RecordLiteral m [realE, realE, realE]
|
|
chanT t = A.Chan (A.ChanAttributes A.Unshared A.Unshared) t
|
|
chanIntT = chanT A.Int
|
|
chansIntT = A.Array [dimension 2] $ chanT A.Int
|
|
uchansIntT = A.Array [A.UnknownDimension] $ chanT A.Int
|
|
intC = variable "chanInt"
|
|
intCin = A.DirectedVariable emptyMeta A.DirInput intC
|
|
intCout = A.DirectedVariable emptyMeta A.DirOutput intC
|
|
intCE = A.ExprVariable m intC
|
|
intsC = variable "chansInt"
|
|
mobileIntV = variable "mobileInt"
|
|
sub0 = A.Subscript m A.NoCheck (intLiteral 0)
|
|
sub0E = A.SubscriptedExpr m sub0
|
|
subx = A.SubscriptField m (simpleName "x")
|
|
subxE = A.SubscriptedExpr m subx
|
|
function0 = simpleName "function0"
|
|
function1 = simpleName "function1"
|
|
function2 = simpleName "function2"
|
|
function22 = simpleName "function22"
|
|
i = simpleName "i"
|
|
countedIntsC = variable "chanCountedInts"
|
|
countedIntsCin = A.DirectedVariable emptyMeta A.DirInput countedIntsC
|
|
countedIntsCout = A.DirectedVariable emptyMeta A.DirOutput countedIntsC
|
|
iirC = variable "chanIIR"
|
|
iirCin = A.DirectedVariable emptyMeta A.DirInput iirC
|
|
iirCout = A.DirectedVariable emptyMeta A.DirOutput iirC
|
|
caseC = variable "chanCaseProto"
|
|
caseCin = A.DirectedVariable emptyMeta A.DirInput caseC
|
|
caseCout = A.DirectedVariable emptyMeta A.DirOutput caseC
|
|
|
|
packed = A.RecordAttr True False
|
|
notPacked = A.RecordAttr False False
|
|
|
|
--}}}
|
|
--{{{ process fragments
|
|
|
|
skip = A.Skip m
|
|
jskip = Just skip
|
|
sskip = A.Only m skip
|
|
insim iis = A.InputSimple m iis
|
|
inputSimple c iis = A.Input m c $ insim iis
|
|
inputCase c vs = A.Input m c
|
|
$ A.InputCase m (A.Several m (map (A.Only m) vs))
|
|
vari tag iis = A.Variant m (simpleName tag) iis skip
|
|
outputSimple c ois = A.Output m c ois
|
|
outputCase c tag ois = A.OutputCase m c (simpleName tag) ois
|
|
testRep n r = A.Seq m $ A.Spec m (A.Specification m n (A.Rep m r)) sskip
|
|
testChoice c = A.If m $ A.Only m c
|
|
testOption e o = A.Case m e $ A.Only m o
|
|
inv = A.InVariable m
|
|
oute = A.OutExpression m
|
|
tim = variable "tim"
|
|
testAlt a = A.Alt m True $ A.Only m a
|
|
proccall n = A.ProcCall m (simpleName n)
|
|
|
|
--}}}
|
|
--{{{ specification fragments
|
|
|
|
returnNone = Just $ Left $ A.Only m $ A.ExpressionList m []
|
|
returnOne = Just $ Left $ A.Only m $ A.ExpressionList m [intE]
|
|
returnTwo = Just $ Left $ A.Only m $ A.ExpressionList m [intE, intE]
|
|
|
|
retypesV = A.Retypes m A.Abbrev
|
|
retypesE = A.RetypesExpr m A.ValAbbrev
|
|
known1 = A.Array [dimension 4] A.Byte
|
|
known2 = A.Array [dimension 2, dimension 2] A.Byte
|
|
both = A.Array [dimension 2, A.UnknownDimension] A.Byte
|
|
unknown1 = A.Array [A.UnknownDimension] A.Int
|
|
unknown2 = A.Array [A.UnknownDimension, A.UnknownDimension] A.Int
|
|
|
|
--}}}
|
|
|
|
vioTests :: Int -> IO Test
|
|
vioTests v = liftM (TestLabel "OccamTypesTest" . TestList) $ sequence $
|
|
map return
|
|
[ testOccamTypes
|
|
]
|
|
++ map (automaticTest FrontendOccam v)
|
|
[ "testcases/automatic/direction-decorators-1.occ.test"
|
|
, "testcases/automatic/direction-decorators-2.occ.test"
|
|
, "testcases/automatic/direction-decorators-3.occ.test"
|
|
, "testcases/automatic/initial-result-1.occ.test"
|
|
, "testcases/automatic/initial-result-2.occ.test"
|
|
, "testcases/automatic/chan-ends.occ.test"
|
|
]
|