/FingTest/TypeTests.fs

  1module Fing.TypeTests
  2open NUnit.Framework
  3open Microsoft.FSharp.Metadata
  4open Util
  5open Types
  6open TestCases
  7open TestUtil
  8
  9[<TestFixture>]
 10type public TypeTester() =
 11  let foldTypar empty singleton concat = 
 12    let rec fold = function
 13    | Var v -> singleton v
 14    | Arrow types -> concat (List.map fold types)
 15    | Tuple types -> concat (List.map fold types)
 16    | Id _ -> empty
 17    | NamedArg(_,t,_) -> fold t
 18    | Generic (t,types) ->
 19      concat (fold t :: List.map fold types)
 20    | Array(_,t) -> fold t
 21    | Constraint(when_,t) ->
 22      concat [fold t; foldWhen when_]
 23    and foldWhen = function
 24    | Null v -> singleton v
 25    | Struct v -> singleton v
 26    | NotStruct v -> singleton v
 27    | DefaultConstructor v -> singleton v
 28    | Enum(v, t) -> concat [singleton v; fold t]
 29    | Delegate(v, t, t') -> concat [singleton v; fold t; fold t']
 30    | Subtype(v, t) -> concat [singleton v; fold t]
 31    | Sig(v, t, t', p) -> concat [singleton v; fold t; fold t']
 32    | TyparConstraint cons -> concat (List.map foldWhen cons)
 33    fold
 34  let usedVars = foldTypar [] (fun x -> [x]) List.concat
 35  let usedIndices = foldTypar Set.empty Set.singleton Set.unionMany
 36  [<Test>]
 37  member this.TestFormat() =
 38    safezip (List.map Parser.parse passes) 
 39            (List.map (Types.format >> Parser.parse) passresults )
 40    |> testall
 41  [<Test>]
 42  member this.TestIndex() =
 43    let randomise seq = Seq.zip seq (seq |> Array.ofSeq |> Array.shuffle)
 44    let subst (t, shuffles) =
 45      let map = Map.ofSeq shuffles
 46      let subst' = function
 47      | Var v -> Some (Var (Map.find v map))
 48      | _ -> None
 49      Types.mapSimple subst' t
 50    let testPropEq f g = safezip (List.map f passresults) (List.map g passresults) |> testall
 51    // 1. length (usedIndices t) == length (usedIndices (index t))
 52    testPropEq (usedIndices >> Set.count) 
 53               (Types.index >> usedIndices >> Set.count)
 54    // 2. length (set (leftToRightListOfVariableNames (index t))) == length (usedIndices (index t))
 55    testPropEq (Types.index >> usedVars >> set >> Set.count)
 56               (Types.index >> usedIndices >> Set.count)
 57  [<Test>]
 58  member this.TestRevMap() =
 59    testWith Types.revMap [
 60      Map.empty, Map.empty
 61      Map.ofList [("a","b")], Map.ofList [("b","a")]
 62      Map.ofList [("a","b");("a","c")], Map.ofList [("c", "a")]
 63    ]
 64  member this.TestMapTypar() =
 65    ()
 66  [<Test>]
 67  member this.TestMapSimple() =
 68    // 1. id == mapSimple Some
 69    forallt (fun t -> (t, Types.mapSimple Some t))
 70    // 2. id == mapSimple None 
 71    forallt (fun t -> (t, Types.mapSimple (constant None) t))
 72  [<Test>]
 73  member this.TestMap() =
 74    // 1. id == map Some Some
 75    forallt (fun t -> (t, Types.map (fun _ _ t -> Some t) (fun _ _ w -> Some w) t))
 76    // 2. id == map None None
 77    forallt (fun t -> (t, Types.map (fun _ _ _ -> None) (fun _ _ _ -> None) t))
 78    // 3. replacing all vars with anonymous via map means that usedVars t == { Anonymous }
 79    let anonymiser _ _ = function
 80    | Var _ -> Some (Var Anonymous)
 81    | _ -> None
 82    let anonymiserW kt kw = function
 83    | Null _ -> Some (Null Anonymous)
 84    | Struct _ -> Some (Struct Anonymous)
 85    | NotStruct _ -> Some (NotStruct Anonymous)
 86    | DefaultConstructor _ -> Some (DefaultConstructor Anonymous)
 87    | Enum(_,t) -> Some (Enum(Anonymous, kt t))
 88    | Delegate(_,t,t') -> Some(Delegate(Anonymous, kt t, kt t'))
 89    | Subtype (_,t) -> Some(Subtype(Anonymous, kt t))
 90    | Sig(_,t,t',prop) -> Some(Sig(Anonymous, kt t, kt t', prop))
 91    | _ -> None
 92    forallt (fun t ->
 93              match Types.map anonymiser anonymiserW t |> usedVars with
 94              | [] -> (Set.empty, Set.empty)
 95              | vs -> (Set.singleton Anonymous, set vs))
 96  [<Test>]
 97  member this.TestUsedIds() =
 98    // this is a DSL because I used Sun-style indentation for my square brackets
 99    // and I passed a function. It's the future!
100    testWith Types.usedIds [
101      Set.empty, Var Anonymous
102      Set.empty, Var (Normal "a")
103      Set.singleton "int", Id "int"
104      Set.singleton "int", Arrow [Id "int"; Id "int"]
105      Set.ofList ["int"; "double"], Arrow [Id "int"; Id "double"]
106      Set.ofList ["int"; "double"], Arrow [Id "int"; Var Anonymous; Id "double"]
107    ]
108[<TestFixture>]
109type public FSharpTypeTester() =
110  let core = FSharpAssembly.FSharpLibrary
111  let rawts = seq { 
112    for e in core.Entities do 
113    for m in e.MembersOrValues do 
114    yield m
115  }
116  [<Test>]
117  member this.TestDebinarise() =
118    let tests = [
119      Arrow [Id "int"], Arrow [Id "int"]
120      Arrow [Id "int"; Id "int"], Arrow [Id "int"; Id "int"]
121      Arrow [Id "int"; Id "int"; Id "int"], Arrow [Id "int"; Arrow [Id "int"; Id "int"]]
122      // right branching only
123      Arrow [Arrow [Id "int"; Id "int"]; Id "int"], Arrow [Arrow [Id "int"; Id "int"]; Id "int"]
124      Var Anonymous, Var Anonymous
125
126
127      Constraint
128        (Sig
129           (Choice [Normal "a"; Normal "b"],Id "read",
130            Arrow [Id "string"; Id "int"; Id "stream"],Function),
131         Generic (Id "list",[Var (Normal "a")])), 
132      Constraint
133        (Sig
134           (Choice [Normal "a"; Normal "b"],Id "read",
135            Arrow [Id "string"; Arrow [Id "int"; Id "stream"]],Function),
136         Generic (Id "list",[Var (Normal "a")]))
137      Constraint
138        (Sig
139          (Normal "a",Generic (Id "read",[Var (Normal "b"); Var (Normal "c")]),
140           Arrow [Var (Normal "a"); Var (Normal "b"); Var (Normal "c")],Function),
141         Generic (Id "list",[Var (Normal "a")])),
142      Constraint
143        (Sig
144          (Normal "a",Generic (Id "read",[Var (Normal "b"); Var (Normal "c")]),
145           Arrow [Var (Normal "a"); Var (Normal "b"); Var (Normal "c")],Function),
146         Generic (Id "list",[Var (Normal "a")]))
147    ]
148    testWith FSharpTypes.debinarize tests
149  [<Test>]
150  member this.TestIsArray() =
151    let gca = rawts |> Seq.find (fun m -> m.DisplayName = "GetCustomAttributes")
152    Assert.IsFalse (FSharpTypes.isArray (gca.Type.GenericArguments.[0]))
153    Assert.IsTrue (FSharpTypes.isArray (gca.Type.GenericArguments.[1].GenericArguments.[1]))
154  [<Test>]
155  member this.TestDimensions() =
156    let gca = rawts |> Seq.find (fun m -> m.DisplayName = "GetCustomAttributes")
157    let ara = gca.Type.GenericArguments.[1].GenericArguments.[1]
158    Assert.AreEqual ("[]", ara.NamedEntity.DisplayName)
159    Assert.AreEqual (1,FSharpTypes.dimensions gca.Type.GenericArguments.[1].GenericArguments.[1])
160  [<Test>]
161  member this.TestCvt() =
162    for t in rawts do
163      if t.Type.IsFunction then
164        Assert.IsTrue (match FSharpTypes.cvt t.Type with
165                       | Arrow _ -> true
166                       | _ -> false)
167      elif t.Type.IsTuple then
168        Assert.IsTrue (match FSharpTypes.cvt t.Type with
169                       | Tuple _ -> true
170                       | _ -> false)
171    let getT name = rawts |> Seq.find (fun t -> t.DisplayName = name)
172    let t1 = getT "GetCustomAttributes"
173    let t2 = getT "GetExceptionFields"
174    let t3 = getT "Cast"
175    let intmod (t : FSharpMemberOrVal) = t.DisplayName = "( % )" 
176                                         && not t.Type.GenericArguments.[0].IsTuple
177    let t4 = rawts |> Seq.find intmod
178    Assert.AreEqual(1, rawts |> Seq.filter intmod |> Seq.length)
179    // TODO: test int defaulting
180    // and someday whenify and canonicalType when those features are to be completed
181    Assert.IsTrue (match FSharpTypes.cvt t1.Type with
182                   | Arrow _ -> true
183                   | _ -> false)
184    Assert.AreEqual(FSharpTypes.cvt t1.Type.GenericArguments.[0], Id "UnionCaseInfo")
185    Assert.AreEqual(FSharpTypes.cvt t1.Type.GenericArguments.[1].GenericArguments.[1],
186                    Array (1, Id "Object"))
187    Assert.IsTrue (match FSharpTypes.cvt t2.Type.GenericArguments.[0] with
188                   | Tuple _ -> true
189                   | _ -> false)
190    Assert.AreEqual(FSharpTypes.cvt t2.Type.GenericArguments.[0].GenericArguments.[1],
191                    Generic (Id "Option", [Id "BindingFlags"]))
192    Assert.AreEqual(FSharpTypes.cvt t3.Type.GenericArguments.[1],
193                    Generic (Id "Expr", [Var (Normal "T")]))
194    Assert.AreEqual(FSharpTypes.cvt t4.Type.GenericArguments.[0],
195                    Id "Int32")