Track inheritance in GenerateMock (#122)

This commit is contained in:
Patrick Stevens
2024-04-16 22:23:32 +01:00
committed by GitHub
parent bfc25a672b
commit f7458f521e
5 changed files with 189 additions and 10 deletions

View File

@@ -21,6 +21,9 @@ module internal InterfaceMockGenerator =
| None -> failwith "Expected record field to have a name, but it was somehow anonymous"
| Some id -> id
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
let createType
(spec : GenerateMockOutputSpec)
(name : string)
@@ -29,6 +32,20 @@ module internal InterfaceMockGenerator =
(fields : SynField list)
: SynModuleDecl
=
let inherits =
interfaceType.Inherits
|> Seq.map (fun ty ->
match ty with
| SynType.LongIdent (SynLongIdent.SynLongIdent (name, _, _)) ->
match name |> List.map _.idText with
| [] -> failwith "Unexpected empty identifier in inheritance declaration"
| [ "IDisposable" ]
| [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable
| _ -> failwithf "Unrecognised inheritance identifier: %+A" name
| x -> failwithf "Unrecognised type in inheritance: %+A" x
)
|> Set.ofSeq
let synValData =
{
SynMemberFlags.IsInstance = false
@@ -90,6 +107,23 @@ module internal InterfaceMockGenerator =
)
|> SynBindingReturnInfo.Create
let constructorFields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createLambda "_" SynExpr.CreateUnit
[
(SynLongIdent.CreateFromLongIdent [ Ident.Create "Dispose" ], true), Some unitFun
]
else
[]
let nonExtras =
fields
|> List.map (fun field -> (SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
extras @ nonExtras
let constructor =
SynMemberDefn.Member (
SynBinding.SynBinding (
@@ -102,12 +136,7 @@ module internal InterfaceMockGenerator =
SynValData.SynValData (Some synValData, SynValInfo.Empty, None),
constructorIdent,
Some constructorReturnType,
AstHelper.instantiateRecord (
fields
|> List.map (fun field ->
((SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
)
),
AstHelper.instantiateRecord constructorFields,
range0,
DebugPointAtBinding.Yes range0,
{ SynExpr.synBindingTriviaZero true with
@@ -117,6 +146,21 @@ module internal InterfaceMockGenerator =
range0
)
let fields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
[
SynField.Create (
SynType.CreateFun (SynType.CreateUnit, SynType.CreateUnit),
Ident.Create "Dispose",
xmldoc = PreXmlDoc.Create " Implementation of IDisposable.Dispose"
)
]
else
[]
extras @ fields
let interfaceMembers =
let members =
interfaceType.Members
@@ -264,11 +308,100 @@ module internal InterfaceMockGenerator =
| Some (SynAccess.Internal _), _ -> SynAccess.Internal range0
| Some (SynAccess.Private _), _ -> SynAccess.Private range0
let extraInterfaces =
inherits
|> Seq.map (fun inheritance ->
match inheritance with
| KnownInheritance.IDisposable ->
let valData =
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
valInfo =
SynValInfo.SynValInfo (
curriedArgInfos =
[
yield
[
SynArgInfo.SynArgInfo (
attributes = [],
optional = false,
ident = None
)
]
],
returnInfo =
SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None)
),
thisIdOpt = None
)
let headArgs = [ SynPat.Const (SynConst.Unit, range0) ]
let headPat =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; Ident.Create "Dispose" ],
None,
None,
SynArgPats.Pats headArgs,
None,
range0
)
let binding =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
valData,
headPat,
Some (
SynBindingReturnInfo.SynBindingReturnInfo (
SynType.Unit (),
range0,
[],
SynBindingReturnInfoTrivia.Zero
)
),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "this" ; "Dispose" ]),
SynExpr.CreateUnit
),
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0)
SynMemberDefn.Interface (
SynType.CreateLongIdent (SynLongIdent.Create [ "System" ; "IDisposable" ]),
Some range0,
Some [ mem ],
range0
)
)
|> Seq.toList
let record =
{
Name = Ident.Create name
Fields = fields
Members = Some [ constructor ; interfaceMembers ]
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
XmlDoc = Some xmlDoc
Generics = interfaceType.Generics
Accessibility = Some access
@@ -333,7 +466,6 @@ module internal InterfaceMockGenerator =
let typeDecl = createType spec name interfaceType docString fields
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ typeDecl ]