Permalink
Browse files

Extend reflection generator to work with any immutable class

  • Loading branch information...
mausch committed Sep 13, 2013
1 parent 855b0b7 commit 288e1366a8e74794288a02e4edee17f46c56991a
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
View
@@ -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)
View
@@ -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.