Permalink
Browse files

Extend reflection generator to work with any immutable class

  • Loading branch information...
1 parent 855b0b7 commit 288e1366a8e74794288a02e4edee17f46c56991a @mausch mausch committed Sep 13, 2013
Showing with 53 additions and 4 deletions.
  1. +22 −1 FsCheck.Test/Arbitrary.fs
  2. +4 −2 FsCheck/Arbitrary.fs
  3. +17 −0 FsCheck/Reflect.fs
  4. +10 −1 FsCheck/ReflectArbitrary.fs
@@ -296,4 +296,25 @@ module Arbitrary =
[<Property>]
let ``Decimal shrinks`` (value: decimal) =
shrink<decimal> value
- |> Seq.forall (fun shrunkv -> shrunkv = 0m || shrunkv <= abs value)
+ |> Seq.forall (fun shrunkv -> shrunkv = 0m || shrunkv <= abs value)
+
+ type Empty() = class end
+
+ [<Fact>]
+ let ``Derive generator for concrete class with one constructor with no parameters``() =
+ generate<Empty> |> sample 10 |> List.forall (fun _ -> true)
+
+ type IntWrapper(a: int) = class end
+
+ [<Fact>]
+ let ``Derive generator for concrete class with one constructor with one parameter``() =
+ generate<IntWrapper> |> sample 10 |> List.forall (fun _ -> true)
+
+ type FakeRecord(a: int, b: string) =
+ member this.A = a
+ member this.B = b
+
+ [<Fact>]
+ let ``Derive generator for concrete class with one constructor with two parameters``() =
+ generate<FakeRecord> |> sample 10 |> List.forall (fun _ -> true)
+
@@ -630,8 +630,10 @@ module Arb =
static member DontShrink() =
generate |> Gen.map DontShrink |> fromGen
- ///Try to derive an arbitrary instance for the given type reflectively. Works
- ///for record, union, tuple and enum types.
+ ///Try to derive an arbitrary instance for the given type reflectively.
+ ///Generates and shrinks values for record, union, tuple and enum types.
+ ///Also generates (but doesn't shrink) values for immutable classes
+ ///(i.e. single constructor, no mutable properties or fields).
static member Derive() =
{ new Arbitrary<'a>() with
override x.Generator = ReflectArbitrary.reflectGen getGenerator
View
@@ -23,6 +23,13 @@ module internal Reflect =
let isRecordType (ty : Type) = FSharpType.IsRecord(ty, recordFieldBindingFlags)
let isUnionType ty = FSharpType.IsUnion ty
let isTupleType ty = FSharpType.IsTuple ty
+ let getPublicCtors (ty: Type) = ty.GetConstructors() |> Array.filter (fun c -> c.IsPublic)
+ let isCSharpRecordType (ty: Type) =
+ ty.IsClass && not ty.IsAbstract
+ && not ty.ContainsGenericParameters
+ && (getPublicCtors ty).Length = 1
+ && not (ty.GetProperties(BindingFlags.Public ||| BindingFlags.Instance) |> Seq.exists (fun p -> p.CanWrite))
+ && ty.GetFields(BindingFlags.Public ||| BindingFlags.Instance) |> Seq.forall (fun f -> f.IsInitOnly)
/// Get information on the fields of a record type
let getRecordFields (recordType: System.Type) =
@@ -38,7 +45,17 @@ module internal Reflect =
/// Get reader for record type
let getRecordReader recordType =
FSharpValue.PreComputeRecordReader(recordType, recordFieldBindingFlags)
+
+ let getCSharpRecordFields (recordType: Type) =
+ if isCSharpRecordType recordType then
+ let ctor = (getPublicCtors recordType).[0]
+ ctor.GetParameters() |> Seq.map (fun p -> p.ParameterType)
+ else
+ failwith "The input type must be an immutable class with a single constructor. Got %A" recordType
+ let getCSharpRecordConstructor (recordType: Type) =
+ let ctor = (getPublicCtors recordType).[0]
+ ctor.Invoke
/// Returns the case name, type, and functions that will construct a constructor and a reader of a union type respectively
let getUnionCases unionType : (string * (int * System.Type list * (obj[] -> obj) * (obj -> obj[]))) list =
@@ -88,7 +88,16 @@ module internal ReflectArbitrary =
elif t.IsEnum then
enumOfType t |> box
-
+
+ elif isCSharpRecordType t then
+ let g = [ for ft in getCSharpRecordFields t do
+ if ft = t then
+ failwithf "Recursive record types cannot be generated automatically: %A" t
+ else yield getGenerator ft ]
+ let create = getCSharpRecordConstructor t
+ let result = g |> sequence |> map (List.toArray >> create)
+ box result
+
else
failwithf "Geneflect: type not handled %A" t)

0 comments on commit 288e136

Please sign in to comment.