Skip to content

Commit fb10fa6

Browse files
kurtschelfthoutkurtschelfthout
authored
Expand automatic generate and shrink support for C# record-like types (#607)
No values were generated for init-only properties in some cases.
1 parent 6777fba commit fb10fa6

File tree

4 files changed

+124
-49
lines changed

4 files changed

+124
-49
lines changed

‎src/FsCheck/Reflect.fs

+66-29
Original file line numberDiff line numberDiff line change
@@ -22,36 +22,61 @@ module internal Reflect =
2222

2323
let getProperties (ty: Type) = ty.GetRuntimeProperties() |> Seq.filter (fun p -> let m = getPropertyMethod p in not m.IsStatic && m.IsPublic)
2424

25-
26-
let isCSharpRecordType (ty: Type) =
27-
let isInitOnly(property: PropertyInfo) =
25+
let isInitOnlyProperty(property: PropertyInfo) =
2826
#if NETSTANDARD1_0
29-
false
27+
false
3028
#else
31-
property.CanWrite
32-
&& (property.SetMethod.ReturnParameter.GetRequiredCustomModifiers()
33-
|> Array.exists (fun t -> t.FullName = "System.Runtime.CompilerServices.IsExternalInit"))
29+
property.CanWrite
30+
&& (property.SetMethod.ReturnParameter.GetRequiredCustomModifiers()
31+
|> Array.exists (fun t -> t.FullName = "System.Runtime.CompilerServices.IsExternalInit"))
3432
#endif
3533

34+
/// An immutable "record-like" type:
35+
/// - must have a single public constructor
36+
/// - must not have any property setters (not even C# init)
37+
/// - must have all init-only fields (readonly in C# - these fields can only be set in the ctor)
38+
/// These can be generated but not shrunk, because there is no reliable way to build a reader,
39+
/// i.e. get the ctor parameter values back out from an existing value, because there's no
40+
/// guarantee that the properties map back to the constructor arguments.
41+
let isImmutableRecordLikeType (ty: Type) =
3642
let typeinfo = ty.GetTypeInfo()
3743
not typeinfo.IsAbstract
3844
&& not typeinfo.ContainsGenericParameters
3945
&& Seq.length (getPublicCtors ty) = 1
40-
&& not (ty.GetRuntimeProperties() |> Seq.filter (fun m -> not m.GetMethod.IsStatic && m.GetMethod.IsPublic) |> Seq.exists (fun p -> p.CanWrite && not (isInitOnly p)))
46+
&& not (ty.GetRuntimeProperties() |> Seq.filter (fun m -> not m.GetMethod.IsStatic && m.GetMethod.IsPublic) |> Seq.exists (fun p -> p.CanWrite))
4147
&& ty.GetRuntimeFields() |> Seq.filter (fun m -> not m.IsStatic && m.IsPublic) |> Seq.forall (fun f -> f.IsInitOnly)
4248

43-
let isCSharpDtoType (ty: Type) =
49+
50+
/// A "C# record" type:
51+
/// - must have a single public constructor
52+
/// - must have a correspondingly named init-only property for every ctor argument
53+
/// - may have additional settable properties (set or init)
54+
/// This should cover types declared using C#'s record syntax, but also others.
55+
/// As opposed to "immutable record-like" types, these can be shrunk automatically.
56+
let isCSharpRecordType (ty: Type) =
4457
let typeinfo = ty.GetTypeInfo()
45-
let hasOnlyDefaultCtor =
58+
let props = getProperties ty |> Seq.toArray
59+
let initOnlyPropNames =
60+
props
61+
|> Array.filter isInitOnlyProperty
62+
|> Array.map (fun p -> p.Name)
63+
let hasRecordCtor =
64+
// either no parameters, or for each parameter there is a corresponding
65+
// init-only property which we can set. THis is what C# generates with its
66+
// record syntax.
4667
match getPublicCtors ty |> Array.ofSeq with
47-
[| ctor |] -> ctor.GetParameters().Length = 0
68+
[| ctor |] ->
69+
ctor.GetParameters()
70+
|> Seq.forall (fun param -> initOnlyPropNames |> Array.contains param.Name)
4871
| _ -> false
4972
let hasWritableProperties =
50-
getProperties ty |> Seq.exists (fun p -> p.CanWrite)
73+
props |> Array.exists (fun p -> p.CanWrite)
5174
typeinfo.IsClass && not typeinfo.IsAbstract
5275
&& not typeinfo.ContainsGenericParameters
53-
&& hasOnlyDefaultCtor && hasWritableProperties
76+
&& hasRecordCtor
77+
&& hasWritableProperties
5478

79+
/// A collection type in the System.Collections.Immutable namespace.
5580
let isImmutableCollectionType (ty: Type) =
5681
ty.FullName.StartsWith("System.Collections.Immutable")
5782
&& Array.contains ty.Name [|
@@ -61,30 +86,30 @@ module internal Reflect =
6186
|]
6287

6388

64-
/// Get information on the fields of a record type
89+
/// Get information on the fields of an F# record type
6590
let getRecordFieldTypes (recordType: System.Type) =
6691
if isRecordType recordType then
6792
FSharpType.GetRecordFields(recordType, true)
6893
|> Array.map (fun pi -> pi.PropertyType)
6994
else
70-
failwithf "The input type must be a record type. Got %A" recordType
95+
failwithf "The input type must be an F# record type. Got %A" recordType
7196

72-
/// Get constructor for record type
97+
/// Get constructor for F# record type
7398
let getRecordConstructor recordType =
7499
FSharpValue.PreComputeRecordConstructor(recordType, true)
75100

76-
/// Get reader for record type
101+
/// Get reader for F# record type
77102
let getRecordReader recordType =
78103
FSharpValue.PreComputeRecordReader(recordType, true)
79104

80-
let getCSharpRecordFields (recordType: Type) =
81-
if isCSharpRecordType recordType then
105+
let getImmutableRecordLikeTypeFields (recordType: Type) =
106+
if isImmutableRecordLikeType recordType then
82107
let ctor = getPublicCtors recordType |> Seq.head
83108
ctor.GetParameters() |> Seq.map (fun p -> p.ParameterType)
84109
else
85110
failwithf "The input type must be an immutable class with a single constructor. Got %A" recordType
86111

87-
let getCSharpRecordConstructor (t:Type) =
112+
let getImmutableRecordLikeTypeConstructor (t:Type) =
88113
let ctor = getPublicCtors t |> Seq.head
89114
let ctorps= ctor.GetParameters ()
90115
let par = Expression.Parameter (typeof<obj[]>, "args")
@@ -98,17 +123,28 @@ module internal Reflect =
98123
let f = l.Compile ()
99124
f.Invoke
100125

101-
let getCSharpDtoFields (recordType: Type) =
102-
if isCSharpDtoType recordType then
126+
let getCSharpRecordFields (recordType: Type) =
127+
if isCSharpRecordType recordType then
103128
getProperties recordType
104129
|> Seq.filter (fun p -> p.CanWrite)
105130
|> Seq.map (fun p -> p.PropertyType)
106131
else
107-
failwithf "The input type must be a DTO class. Got %A" recordType
132+
failwithf "The input type must be a C# record-like class. Got %A" recordType
108133

109-
let getCSharpDtoConstructor (t:Type) =
134+
let getCSharpRecordConstructor (t:Type) =
135+
let props = getProperties t |> Seq.filter (fun p -> p.CanWrite) |> Seq.toArray
136+
let propNames = props |> Array.map (fun p -> p.Name)
137+
138+
let ctor = getPublicCtors t |> Seq.head
139+
let ctorps= ctor.GetParameters ()
140+
let ctorParamPropIndex =
141+
ctorps
142+
|> Array.map (fun ctorParam -> propNames |> Array.findIndex (fun propName -> propName = ctorParam.Name))
110143
let par = Expression.Parameter (typeof<obj[]>, "args")
111-
let props = getProperties t |> Seq.filter (fun p -> p.CanWrite)
144+
let pars = ctorps |> Array.mapi (fun i p -> Expression.Convert (
145+
Expression.ArrayIndex (par, Expression.Constant ctorParamPropIndex.[i]),
146+
p.ParameterType)
147+
:> Expression)
112148
let values =
113149
props
114150
|> Seq.mapi (fun i p ->
@@ -118,22 +154,23 @@ module internal Reflect =
118154
props
119155
|> Seq.zip values
120156
|> Seq.map (fun (v, p) -> Expression.Bind(p, v) :> MemberBinding)
121-
let ctor = Expression.New(getPublicCtors t |> Seq.head)
157+
158+
let ctor = Expression.New (ctor, pars)
122159
let body = Expression.MemberInit(ctor, bindings)
123160
let l = Expression.Lambda<Func<obj[], obj>> (body, par)
124161
let f = l.Compile ()
125162
f.Invoke
126163

127-
let getCSharpDtoReader (recordType: Type) =
128-
if isCSharpDtoType recordType then
164+
let getCSharpRecordReader (recordType: Type) =
165+
if isCSharpRecordType recordType then
129166
let properties = getProperties recordType
130167
|> Seq.filter (fun p -> p.CanWrite)
131168
|> Seq.map (fun p -> p.GetValue)
132169
|> Seq.toArray
133170
let lookup o = Array.map (fun f -> f o) properties
134171
lookup
135172
else
136-
failwithf "The input type must be a DTO class. Got %A" recordType
173+
failwithf "The input type must be a C# record-like class. Got %A" recordType
137174

138175
/// Returns the case name, type, and functions that will construct a constructor and a reader of a union type respectively
139176
let getUnionCases unionType : (string * (int * System.Type list * (obj[] -> obj) * (obj -> obj[]))) list =

‎src/FsCheck/ReflectArbitrary.fs

+10-10
Original file line numberDiff line numberDiff line change
@@ -118,19 +118,19 @@ module internal ReflectArbitrary =
118118
elif t.GetTypeInfo().IsEnum then
119119
enumOfType t |> box
120120

121-
elif isCSharpRecordType t then
122-
let fields = getCSharpRecordFields t
121+
elif isImmutableRecordLikeType t then
122+
let fields = getImmutableRecordLikeTypeFields t
123123
if fields |> Seq.exists ((=) t) then
124124
failwithf "Recursive record types cannot be generated automatically: %A" t
125-
let create = getCSharpRecordConstructor t
125+
let create = getImmutableRecordLikeTypeConstructor t
126126
let g = productGen fields create
127127
box g
128128

129-
elif isCSharpDtoType t then
130-
let fields = getCSharpDtoFields t
129+
elif isCSharpRecordType t then
130+
let fields = getCSharpRecordFields t
131131
if fields |> Seq.exists ((=) t) then
132132
failwithf "Recursive record types cannot be generated automatically: %A" t
133-
let create = getCSharpDtoConstructor t
133+
let create = getCSharpRecordConstructor t
134134
let g = productGen fields create
135135
box g
136136

@@ -245,10 +245,10 @@ module internal ReflectArbitrary =
245245
let read = FSharpValue.GetTupleFields
246246
shrinkChildren read make o childrenTypes
247247

248-
elif isCSharpDtoType t then
249-
let make = getCSharpDtoConstructor t
250-
let read = getCSharpDtoReader t
251-
let childrenTypes = getCSharpDtoFields t
248+
elif isCSharpRecordType t then
249+
let make = getCSharpRecordConstructor t
250+
let read = getCSharpRecordReader t
251+
let childrenTypes = getCSharpRecordFields t
252252
shrinkChildren read make o childrenTypes
253253

254254
elif isImmutableCollectionType t then

‎tests/FsCheck.Test.CSharp/Records.cs

+5
Original file line numberDiff line numberDiff line change
@@ -21,4 +21,9 @@ public record PersonWithHeight : Person
2121
public PersonWithHeight Grow(int inches) =>
2222
this with { HeightInInches = HeightInInches + inches };
2323
}
24+
25+
public record CtorAndProps(int A)
26+
{
27+
public int B { get; init; }
28+
}
2429
}

‎tests/FsCheck.Test/Arbitrary.fs

+43-10
Original file line numberDiff line numberDiff line change
@@ -722,8 +722,41 @@ module Arbitrary =
722722
generate<CSharp.RgbColor> |> sample 10 |> ignore
723723
generate<CSharp.CsRecordExample1> |> sample 10 |> ignore
724724
generate<CSharp.CsRecordExample2> |> sample 10 |> ignore
725-
generate<CSharp.Person> |> sample 10 |> ignore
726-
generate<CSharp.PersonWithHeight> |> sample 10 |> ignore
725+
726+
let persons = generate<CSharp.Person> |> sample 10
727+
test <@ persons |> Seq.exists(fun p -> not (System.String.IsNullOrEmpty(p.FirstName))) @>
728+
729+
let personsWithHeight = generate<CSharp.PersonWithHeight> |> sample 10
730+
test <@ personsWithHeight |> Seq.exists(fun p -> not (System.String.IsNullOrEmpty(p.FirstName))) @>
731+
test <@ personsWithHeight |> Seq.exists(fun p -> p.HeightInInches <> 0) @>
732+
733+
let mixed = generate<CSharp.CtorAndProps> |> sample 10
734+
test <@ mixed |> Seq.exists(fun p -> p.B <> 0) @>
735+
736+
737+
[<Property>]
738+
let ``Derived generator for c# record types shrinks - RgbColor`` (value: CSharp.RgbColor) =
739+
let shrunk = shrink value
740+
shrunk
741+
|> Seq.forall (fun shrunkv ->
742+
shrunkv <> value
743+
&& (shrunkv.Red <= value.Red || shrunkv.Green <= value.Green || shrunkv.Blue <= value.Blue))
744+
745+
[<Property>]
746+
let ``Derived generator for c# record types shrinks - Person`` (value: CSharp.Person) =
747+
let shrunk = shrink value
748+
shrunk
749+
|> Seq.forall (fun shrunkv ->
750+
shrunkv <> value
751+
&& (shrunkv.FirstName <= value.FirstName || shrunkv.LastName <= value.LastName))
752+
753+
[<Property>]
754+
let ``Derived generator for c# record types shrinks - CtorAndProps`` (value: CSharp.CtorAndProps) =
755+
let shrunk = shrink value
756+
shrunk
757+
|> Seq.forall (fun shrunkv ->
758+
shrunkv <> value
759+
&& (abs shrunkv.A <= abs value.A || abs shrunkv.B <= abs value.B))
727760

728761

729762
[<Fact>]
@@ -744,12 +777,12 @@ module Arbitrary =
744777
shrunkValues.Length < values.Length
745778
|| (Array.zip values shrunkValues
746779
|> Array.exists (fun (value,shrunkValue) -> shrunkValue <> value))
747-
assert (ImmutableArray.Create<int>(values) |> shrink |> Seq.forall checkShrink)
748-
assert (ImmutableHashSet.Create<int>(values) |> shrink |> Seq.forall checkShrink)
749-
assert (ImmutableList.Create<int>(values) |> shrink |> Seq.forall checkShrink)
750-
assert (ImmutableQueue.Create<int>(values) |> shrink |> Seq.forall checkShrink)
751-
assert (ImmutableSortedSet.Create<int>(values) |> shrink |> Seq.forall checkShrink)
752-
assert (ImmutableStack.Create<int>(values) |> shrink |> Seq.forall checkShrink)
780+
test <@ (ImmutableArray.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
781+
test <@ (ImmutableHashSet.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
782+
test <@ (ImmutableList.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
783+
test <@ (ImmutableQueue.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
784+
test <@ (ImmutableSortedSet.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
785+
test <@ (ImmutableStack.Create<int>(values) |> shrink |> Seq.forall checkShrink) @>
753786

754787
[<Property>]
755788
let ``should shrink Immutable collections with two generic parameters``(values: Dictionary<int,char>) =
@@ -760,5 +793,5 @@ module Arbitrary =
760793
|| (Array.zip (values.ToArray()) shrunkValues
761794
|> Array.exists (fun (value,shrunkValue) -> shrunkValue <> value))
762795

763-
assert (ImmutableDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink)
764-
assert (ImmutableSortedDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink)
796+
test <@ (ImmutableDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink) @>
797+
test <@ (ImmutableSortedDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink) @>

0 commit comments

Comments
 (0)