From 1056c03163a0f61ba60383401cea08bdfe81b53f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A1s=20Jank=C3=B3?= Date: Tue, 2 Aug 2016 17:46:52 +0200 Subject: [PATCH] fix #568: recognize provided expressions --- FSharp.Compiler.Service.sln | 22 +- src/absil/il.fs | 58 +++- src/absil/il.fsi | 3 + src/fsharp/TastOps.fs | 43 ++- src/fsharp/tast.fs | 10 +- src/fsharp/vs/Exprs.fs | 260 +++++++++++++----- tests/service/ExprTests.fs | 85 +++--- .../FSharp.Compiler.Service.Tests.fsproj | 5 + tests/service/ProjectAnalysisTests.fs | 4 +- tests/service/ProjectOptionsTests.fs | 8 +- .../data/CSharp_Analysis/CSharpClass.cs | 27 +- .../CSharp_Analysis/CSharp_Analysis.csproj | 2 +- tests/service/data/TestProject/Library.fs | 25 +- .../data/TestProject/TestProject.fsproj | 5 + tests/service/data/TestTP/Library.fs | 130 ++++++++- tests/service/data/TestTP/TestTP.fsproj | 10 +- 16 files changed, 555 insertions(+), 142 deletions(-) diff --git a/FSharp.Compiler.Service.sln b/FSharp.Compiler.Service.sln index 102466fc01..0a8d7b21c5 100644 --- a/FSharp.Compiler.Service.sln +++ b/FSharp.Compiler.Service.sln @@ -1,6 +1,6 @@ Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 14 -VisualStudioVersion = 14.0.25123.0 +VisualStudioVersion = 14.0.25420.1 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{B6B68AE6-E7A4-4D43-9B34-FFA74BFE192B}" ProjectSection(SolutionItems) = preProject @@ -63,6 +63,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.Pro EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.ProjectCracker", "src\fsharp\FSharp.Compiler.Service.ProjectCracker\FSharp.Compiler.Service.ProjectCracker.fsproj", "{893C3CD9-5AF8-4027-A667-21E62FC2C703}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestTP", "tests\service\data\TestTP\TestTP.fsproj", "{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -247,6 +249,24 @@ Global {893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU {893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.Build.0 = Release|Any CPU {893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|x86.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.Build.0 = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.ActiveCfg = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.Build.0 = Debug|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.Build.0 = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.Build.0 = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.Build.0 = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.Build.0 = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.Build.0 = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.ActiveCfg = Release|Any CPU + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/src/absil/il.fs b/src/absil/il.fs index 9e034f706b..80c4d98632 100755 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -4265,6 +4265,58 @@ let compareILVersions (a1,a2,a3,a4) ((b1,b2,b3,b4) : ILVersionInfo) = if c <> 0 then c else 0 +let qunscope_scoref scoref_old = + match scoref_old with + | ILScopeRef.Local -> None + | _ -> Some ILScopeRef.Local + +let qunscope_tref (x:ILTypeRef) = + match qunscope_scoref x.Scope with + | None -> None + | Some s -> Some (ILTypeRef.Create(s,x.Enclosing,x.Name)) + +let unscopeILScopeRef y = match qunscope_scoref y with Some x -> x | None -> y +let unscopeILTypeRef y = match qunscope_tref y with Some x -> x | None -> y + +let rec unscopeILTypeSpecQuick (tspec:ILTypeSpec) = + let tref = tspec.TypeRef + let tinst = tspec.GenericArgs + let qtref = qunscope_tref tref + if ILList.isEmpty tinst && isNone qtref then + None (* avoid reallocation in the common case *) + else + match qtref with + | None -> Some (ILTypeSpec.Create (tref, unscopeILTypes tinst)) + | Some tref -> Some (ILTypeSpec.Create (tref, unscopeILTypes tinst)) + +and unscopeILTypeSpec x y = + match rescopeILTypeSpecQuick x y with + | Some x -> x + | None -> y + +and unscopeILType typ = + match typ with + | ILType.Ptr t -> ILType.Ptr (unscopeILType t) + | ILType.FunctionPointer t -> ILType.FunctionPointer (unscopeILCallSig t) + | ILType.Byref t -> ILType.Byref (unscopeILType t) + | ILType.Boxed cr -> + match unscopeILTypeSpecQuick cr with + | Some res -> mkILBoxedType res + | None -> typ // avoid reallocation in the common case + | ILType.Array (s,ty) -> ILType.Array (s,unscopeILType ty) + | ILType.Value cr -> + match unscopeILTypeSpecQuick cr with + | Some res -> ILType.Value res + | None -> typ // avoid reallocation in the common case + | ILType.Modified(b,tref,ty) -> ILType.Modified(b,unscopeILTypeRef tref, unscopeILType ty) + | x -> x + +and unscopeILTypes i = + if ILList.isEmpty i then i + else ILList.map unscopeILType i + +and unscopeILCallSig csig = + mkILCallSigRaw (csig.CallingConv,unscopeILTypes csig.ArgTypes,unscopeILType csig.ReturnType) let resolveILMethodRefWithRescope r td (mref:ILMethodRef) = let args = mref.ArgTypes @@ -4272,13 +4324,15 @@ let resolveILMethodRefWithRescope r td (mref:ILMethodRef) = let nm = mref.Name let possibles = td.Methods.FindByNameAndArity (nm,nargs) if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name); + let argTypes = mref.ArgTypes |> List.map r + let retType : ILType = r mref.ReturnType match possibles |> List.filter (fun md -> mref.CallingConv = md.CallingConv && // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - (md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) && + (md.Parameters,argTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) && // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct - r md.Return.Type = mref.ReturnType) with + r md.Return.Type = retType) with | [] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name) | [mdef] -> mdef | _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name) diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 6a24738cda..5515794cc5 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1973,6 +1973,9 @@ val rescopeILMethodRef: ILScopeRef -> ILMethodRef -> ILMethodRef /// the new scope. val rescopeILFieldRef: ILScopeRef -> ILFieldRef -> ILFieldRef +/// Unscoping. Clears every scope information, use for looking up IL method references only. +val unscopeILType: ILType -> ILType + //----------------------------------------------------------------------- // The ILCode Builder utility. diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 2be517b27d..2c39590caf 100755 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -621,16 +621,18 @@ let reduceTyconRefMeasureableOrProvided (g:TcGlobals) (tcref:TyconRef) tyargs = let rec stripTyEqnsA g canShortcut ty = let ty = stripTyparEqnsAux canShortcut ty match ty with - | TType_app (tcref,tinst) -> + | TType_app (tcref,args) -> let tycon = tcref.Deref + let strippedArgs = args |> List.map (stripTyEqnsA g canShortcut) match tycon.TypeAbbrev with | Some abbrevTy -> - stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon tinst) + stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon strippedArgs) | None -> - if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) tinst then - stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon tinst) - else + if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) args then + stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon strippedArgs) + elif List.isEmpty args || List.forall2 (===) args strippedArgs then ty + else instType (mkTyconInst tycon strippedArgs) ty | ty -> ty let stripTyEqns g ty = stripTyEqnsA g false ty @@ -644,14 +646,20 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple g ty = match ty with | TType_app (tcref,args) -> let tycon = tcref.Deref - if tycon.IsErased then - stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon args) - elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then - stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty - else - ty - | TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) - | TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l + let strippedArgs = args |> List.map (stripTyEqnsAndErase eraseFuncAndTuple g) + match tycon.TypeAbbrev with + | Some abbrevTy -> + stripTyEqnsAndErase eraseFuncAndTuple g (applyTyconAbbrev abbrevTy tycon strippedArgs) + | None -> + if tycon.IsErased then + stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon strippedArgs) + elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then + stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty + elif List.isEmpty args || List.forall2 (===) args strippedArgs then + ty + else instType (mkTyconInst tycon strippedArgs) ty + | TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) |> stripTyEqnsAndErase eraseFuncAndTuple g + | TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l |> stripTyEqnsAndErase eraseFuncAndTuple g | ty -> ty let stripTyEqnsAndMeasureEqns g ty = @@ -825,7 +833,8 @@ and typarConstraintsAEquivAux erasureFlag g aenv tpc1 tpc2 = and typarConstraintSetsAEquivAux erasureFlag g aenv (tp1:Typar) (tp2:Typar) = tp1.StaticReq = tp2.StaticReq && - ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints + (tp1.Rigidity = TyparRigidity.Unresolved || tp2.Rigidity = TyparRigidity.Unresolved || + ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints) and typarsAEquivAux erasureFlag g (aenv: TypeEquivEnv) tps1 tps2 = List.length tps1 = List.length tps2 && @@ -841,7 +850,11 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 = let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2 match ty1, ty2 with | TType_forall(tps1,rty1), TType_forall(tps2,rty2) -> - typarsAEquivAux erasureFlag g aenv tps1 tps2 && typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2 + let sameConstraints = typarsAEquivAux erasureFlag g aenv tps1 tps2 + if sameConstraints then + typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2 + else + false | TType_var tp1, TType_var tp2 when typarEq tp1 tp2 -> true | TType_var tp1, _ when aenv.EquivTypars.ContainsKey tp1 -> diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 0156aae390..f169697fb4 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -274,6 +274,8 @@ type TyparRigidity = /// Indicates the type parameter derives from an '_' anonymous type /// For units-of-measure, we give a warning if this gets solved to '1' | Anon + /// Indicates a type parameter coming from an IL method reference + | Unresolved member x.ErrorIfUnified = match x with TyparRigidity.Rigid -> true | _ -> false member x.WarnIfUnified = match x with TyparRigidity.WillBeRigid | TyparRigidity.WarnIfNotRigid -> true | _ -> false member x.WarnIfMissingConstraint = match x with TyparRigidity.WillBeRigid -> true | _ -> false @@ -294,7 +296,8 @@ type TyparFlags(flags:int32) = | TyparRigidity.WillBeRigid -> 0b000000100000 | TyparRigidity.WarnIfNotRigid -> 0b000001000000 | TyparRigidity.Flexible -> 0b000001100000 - | TyparRigidity.Anon -> 0b000010000000) ||| + | TyparRigidity.Anon -> 0b000010000000 + | TyparRigidity.Unresolved -> 0b000010100000) ||| (match kind with | TyparKind.Type -> 0b000000000000 | TyparKind.Measure -> 0b000100000000) ||| @@ -326,6 +329,7 @@ type TyparFlags(flags:int32) = | 0b000001000000 -> TyparRigidity.WarnIfNotRigid | 0b000001100000 -> TyparRigidity.Flexible | 0b000010000000 -> TyparRigidity.Anon + | 0b000010100000 -> TyparRigidity.Unresolved | _ -> failwith "unreachable" /// Indicates whether a type variable can be instantiated by types or units-of-measure. @@ -774,7 +778,7 @@ type Entity = /// Get the Abstract IL scope, nesting and metadata for this /// type definition, assuming it is backed by Abstract IL metadata. - member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) | _ -> assert false; failwith "not a .NET type definition" + member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) | i -> failwithf "not a .NET type definition: %+A" i /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. member x.ILTyconRawMetadata = let _,_,td = x.ILTyconInfo in td @@ -4551,6 +4555,8 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false) +let NewUnresolvedTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Unresolved,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false) + let NewUnionCase id nm tys rty attribs docOption access : UnionCase = { Id=id CompiledName=nm diff --git a/src/fsharp/vs/Exprs.fs b/src/fsharp/vs/Exprs.fs index 70d24c52e9..b1f7b99ab8 100644 --- a/src/fsharp/vs/Exprs.fs +++ b/src/fsharp/vs/Exprs.fs @@ -15,78 +15,6 @@ open Microsoft.FSharp.Compiler.QuotationTranslator open Microsoft.FSharp.Compiler.TypeRelations open Internal.Utilities - -[] -module ExprUtilsImpl = - - // ILCall nodes arise from calls to .NET methods, and provided calls to - // F# methods. This method attempts to take the information in a ILMethodRef - // and bind it to a symbol. This is not fool proof when the ILCall refers to - // an F# method, but is a good approximation. - let bindILMethodRefToSymbol (cenv:Impl.cenv) m (ilMethRef: ILMethodRef) = - let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef - let enclosingType = generalizedTyconRef tcref - // First try to resolve it to IL metadata - let try1 = - if tcref.IsILTycon then - try - let mdef = resolveILMethodRefWithRescope (rescopeILType (p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef - let minfo = MethInfo.CreateILMeth(cenv.amap, m, enclosingType, mdef) - Some (FSharpMemberOrFunctionOrValue(cenv, minfo)) - with _ -> None - else None - - // Otherwise try to bind it to an F# symbol - match try1 with - | Some res -> res - | None -> - try - // Try to bind the call to an F# method call - let memberParentName = if tcref.IsModuleOrNamespace then None else Some tcref.LogicalName - // TODO: this logical name is not correct in the presence of CompiledName - let logicalName = ilMethRef.Name - let isMember = memberParentName.IsSome - if isMember then - let isCtor = (ilMethRef.Name = ".ctor") - let isStatic = isCtor || ilMethRef.CallingConv.IsStatic - let scoref = ilMethRef.EnclosingTypeRef.Scope - let typars1 = tcref.Typars(m) - let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewRigidTypar "T" m) - let tinst1 = typars1 |> generalizeTypars - let tinst2 = typars2 |> generalizeTypars - // TODO: this will not work for curried methods in F# classes. - // This is difficult to solve as the information in the ILMethodRef - // is not sufficient to resolve to a symbol unambiguously in these cases. - let argtys = [ ilMethRef.ArgTypes |> List.map (ImportILTypeFromMetadata cenv.amap m scoref tinst1 tinst2) ] - let rty = - match ImportReturnTypeFromMetaData cenv.amap m ilMethRef.ReturnType scoref tinst1 tinst2 with - | None -> if isCtor then enclosingType else cenv.g.unit_ty - | Some ty -> ty - - let linkageType = - let ty = mkIteratedFunTy (List.map (mkTupledTy cenv.g) argtys) rty - let ty = if isStatic then ty else mkFunTy enclosingType ty - tryMkForallTy (typars1 @ typars2) ty - - let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1) - let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType) - - let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath - let vref = mkNonLocalValRef enclosingNonLocalRef key - vref.Deref |> ignore // check we can dereference the value - let minfo = MethInfo.FSMeth(cenv.g, enclosingType, vref, None) - FSharpMemberOrFunctionOrValue(cenv, minfo) - else - let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None) - let vref = mkNonLocalValRef tcref.nlr key - vref.Deref |> ignore // check we can dereference the value - FSharpMemberOrFunctionOrValue(cenv, vref) - - with _ -> - failwith (sprintf "A call to '%s' could not be resolved" (ilMethRef.ToString())) - - - [] module ExprTranslationImpl = @@ -683,9 +611,8 @@ module FSharpExprConvert = | FSharpForLoopDown -> E.FastIntegerForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body,false) | _ -> failwith "unexpected for-loop form" - | TOp.ILCall(_,_,_,isNewObj,_valUseFlags,_isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> - let v = bindILMethodRefToSymbol cenv m ilMethRef - ConvObjectModelCallLinear cenv env (isNewObj, v, enclTypeArgs, methTypeArgs, callArgs) (fun e -> e) + | TOp.ILCall(_,_,_,isNewObj,valUseFlags,_isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> + ConvILCall cenv env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) | TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> E.TryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2) @@ -752,6 +679,189 @@ module FSharpExprConvert = let envinner = env.BindVal v Some(vR,rhsR),envinner + and ConvILCall cenv env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = + let isNewObj = (isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false)) + let methName = ilMethRef.Name + let isPropGet = methName.StartsWith("get_",System.StringComparison.Ordinal) + let isPropSet = methName.StartsWith("set_",System.StringComparison.Ordinal) + let isProp = isPropGet || isPropSet + + let tcref, subClass = + try + // if the type is an union case class, lookup will fail + Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef, None + with _ -> + let e = ilMethRef.EnclosingTypeRef + let parent = ILTypeRef.Create(e.Scope, e.Enclosing.Tail, e.Enclosing.Head) + Import.ImportILTypeRef cenv.amap m parent, Some e.Name + + let enclosingType = generalizedTyconRef tcref + + let makeCall minfo = + ConvObjectModelCallLinear cenv env (isNewObj, minfo, enclTypeArgs, methTypeArgs, callArgs) id + + let makeFSCall isMember (vr: ValRef) = + let memOrVal = + if isMember then + let minfo = MethInfo.FSMeth(cenv.g, enclosingType, vr, None) + FSharpMemberOrFunctionOrValue(cenv, minfo) + else + FSharpMemberOrFunctionOrValue(cenv, vr) + makeCall memOrVal + + // takes a possibly fake ValRef and tries to resolve it to an F# expression + let makeFSExpr isMember (vr: ValRef) = + let nlr = vr.nlr + let e = + try + nlr.EnclosingEntity.Deref + with _ -> + failwithf "Failed to resolve type '%s'" (nlr.EnclosingEntity.CompiledName) + let ccu = nlr.EnclosingEntity.nlr.Ccu + let vName = nlr.ItemKey.PartialKey.LogicalName // this is actually compiled name + let findByName = + e.MembersOfFSharpTyconSorted |> List.filter (fun v -> v.CompiledName = vName) + match findByName with + | [v] -> + makeFSCall isMember v + | [] -> + let typR = ConvType cenv (mkAppTy tcref enclTypeArgs) + if e.IsModuleOrNamespace then + let findModuleMemberByName = e.ModuleOrNamespaceType.AllValsAndMembers |> Seq.tryFind (fun v -> v.CompiledName = vName) + match findModuleMemberByName with + | Some v -> + let vr = VRefNonLocalPreResolved v nlr + makeFSCall isMember vr + | _ -> + failwithf "Module member not found: %s" vName + elif e.IsRecordTycon then + if isProp then + let name = PrettyNaming.ChopPropertyName vName + let projR = ConvRecdFieldRef cenv (RFRef(tcref, name)) + let objR = ConvLValueExpr cenv env callArgs.Head + if isPropGet then + E.FSharpFieldGet(Some objR, typR, projR) + else + let valR = ConvExpr cenv env callArgs.Tail.Head + E.FSharpFieldSet(Some objR, typR, projR, valR) + elif vName = ".ctor" then + let argsR = ConvExprs cenv env callArgs + E.NewRecord(typR, argsR) + else + failwith "Failed to recognize record type member" + elif e.IsUnionTycon then + if vName = "GetTag" then + let objR = ConvExpr cenv env callArgs.Head + E.UnionCaseTag(objR, typR) + elif vName.StartsWith("New") then + let name = vName.Substring(3) + let mkR = ConvUnionCaseRef cenv (UCRef(tcref, name)) + let argsR = ConvExprs cenv env callArgs + E.NewUnionCase(typR, mkR, argsR) + elif vName.StartsWith("Is") then + let name = vName.Substring(2) + let mkR = ConvUnionCaseRef cenv (UCRef(tcref, name)) + let objR = ConvExpr cenv env callArgs.Head + E.UnionCaseTest(objR, typR, mkR) + else + match subClass with + | Some name -> + let ucref = UCRef(tcref, name) + let mkR = ConvUnionCaseRef cenv ucref + let objR = ConvLValueExpr cenv env callArgs.Head + let projR = FSharpField(cenv, ucref, ucref.Index) + E.UnionCaseGet(objR, typR, mkR, projR) + | _ -> + failwith "Failed to recognize union type member" + else + let names = e.MembersOfFSharpTyconSorted |> List.map (fun v -> v.CompiledName) |> String.concat ", " + failwithf "Member '%s' not found in type %s, found: %s" vName e.DisplayName names + | _ -> // member is overloaded + match nlr.ItemKey.TypeForLinkage with + | None -> failwith "Type of signature could not be resolved" + | Some keyTy -> + let findBySig = + findByName |> List.tryFind (fun v -> ccu.MemberSignatureEquality(keyTy,v.Type)) + match findBySig with + | Some v -> + makeFSCall isMember v + | _ -> + failwith "Failed to recognize F# member" + + // First try to resolve it to IL metadata + let try1 = + if tcref.IsILTycon then + try + let mdef = resolveILMethodRefWithRescope unscopeILType tcref.ILTyconRawMetadata ilMethRef + let minfo = MethInfo.CreateILMeth(cenv.amap, m, enclosingType, mdef) + FSharpMemberOrFunctionOrValue(cenv, minfo) |> makeCall |> Some + with _ -> + None + else + None + + // Otherwise try to bind it to an F# symbol + match try1 with + | Some res -> res + | None -> + try + // Try to bind the call to an F# method call + let memberParentName = if tcref.IsModuleOrNamespace then None else Some tcref.LogicalName + // this logical name is not correct in the presence of CompiledName + let logicalName = ilMethRef.Name + let isMember = memberParentName.IsSome + if isMember then + match ilMethRef.Name, ilMethRef.EnclosingTypeRef.Name with + | "Invoke", "Microsoft.FSharp.Core.FSharpFunc`2" -> + let objR = ConvLValueExpr cenv env callArgs.Head + let argR = ConvExpr cenv env callArgs.Tail.Head + let typR = ConvType cenv enclTypeArgs.Head + E.Application(objR, [typR], [argR]) + | _ -> + let isCtor = (ilMethRef.Name = ".ctor") + let isStatic = isCtor || ilMethRef.CallingConv.IsStatic + let scoref = ilMethRef.EnclosingTypeRef.Scope + let typars1 = tcref.Typars(m) + let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewUnresolvedTypar "T" m) + let tinst1 = typars1 |> generalizeTypars + let tinst2 = typars2 |> generalizeTypars + // TODO: this will not work for curried methods in F# classes. + // This is difficult to solve as the information in the ILMethodRef + // is not sufficient to resolve to a symbol unambiguously in these cases. + let argtys = [ ilMethRef.ArgTypes |> List.map (ImportILTypeFromMetadata cenv.amap m scoref tinst1 tinst2) ] + let rty = + match ImportReturnTypeFromMetaData cenv.amap m ilMethRef.ReturnType scoref tinst1 tinst2 with + | None -> if isCtor then enclosingType else cenv.g.unit_ty + | Some ty -> ty + + let linkageType = + let ty = mkIteratedFunTy (List.map (mkTupledTy cenv.g) argtys) rty + let ty = if isStatic then ty else mkFunTy enclosingType ty + tryMkForallTy (typars1 @ typars2) ty + + let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType) + + let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath + + try + let vref = mkNonLocalValRef enclosingNonLocalRef key + makeFSExpr isMember vref + with _ -> + // union compiler generated members can be found up in parent module/namespace + // also class members with a CompiledName + let (PubPath p) = tcref.PublicPath.Value + let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu p + let vref = mkNonLocalValRef enclosingNonLocalRef key + makeFSExpr isMember vref + else + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None) + let vref = mkNonLocalValRef tcref.nlr key + makeFSExpr isMember vref + + with e -> + failwithf "An IL call to '%s' could not be resolved: %s" (ilMethRef.ToString()) e.Message + and ConvObjectModelCallLinear cenv env (isNewObj, v:FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs,callArgs) contf = let enclTyArgsR = ConvTypes cenv enclTyArgs let methTyArgsR = ConvTypes cenv methTyArgs diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 5cd932084d..74265e2565 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -107,14 +107,14 @@ module Utils = not (match excludes with None -> false | Some t -> t.Contains v.CompiledName) then let text = //printfn "%s" v.CompiledName - //try + try if v.IsMember then sprintf "member %s%s = %s @ %s" v.CompiledName (printCurriedParams vs) (printExpr 0 e) (e.Range.ToShortString()) else sprintf "let %s%s = %s @ %s" v.CompiledName (printCurriedParams vs) (printExpr 0 e) (e.Range.ToShortString()) - //with e -> - // printfn "FAILURE STACK: %A" e - // sprintf "!!!!!!!!!! FAILED on %s @ %s, message: %s" v.CompiledName (v.DeclarationLocation.ToString()) e.Message + with e -> + printfn "FAILURE STACK: %A" e + sprintf "!!!!!!!!!! FAILED on %s @ %s, message: %s" v.CompiledName (v.DeclarationLocation.ToString()) e.Message yield text | FSharpImplementationFileDeclaration.InitAction(e) -> yield sprintf "do %s" (printExpr 0 e) } @@ -452,7 +452,7 @@ let ``Test Declarations project1`` () = "let recFuncIgnoresFirstArg(g) (v) = v @ (32,33--32,34)"; "let testFun4(unitVar0) = let rec ... in recValNeverUsedAtRuntime @ (36,4--39,28)"; "type ClassWithImplicitConstructor"; - "member .ctor(compiledAsArg) = (Object..ctor (); (this.compiledAsArg <- compiledAsArg; (this.compiledAsField <- 1; let compiledAsLocal: Microsoft.FSharp.Core.int = 1 in let compiledAsLocal2: Microsoft.FSharp.Core.int = Operators.op_Addition (compiledAsLocal,compiledAsLocal) in ()))) @ (41,5--41,33)"; + "member .ctor(compiledAsArg) = (new Object(); (this.compiledAsArg <- compiledAsArg; (this.compiledAsField <- 1; let compiledAsLocal: Microsoft.FSharp.Core.int = 1 in let compiledAsLocal2: Microsoft.FSharp.Core.int = Operators.op_Addition (compiledAsLocal,compiledAsLocal) in ()))) @ (41,5--41,33)"; "member .cctor(unitVar) = (compiledAsStaticField <- 1; let compiledAsStaticLocal: Microsoft.FSharp.Core.int = 1 in let compiledAsStaticLocal2: Microsoft.FSharp.Core.int = Operators.op_Addition (compiledAsStaticLocal,compiledAsStaticLocal) in ()) @ (49,11--49,40)"; "member M1(__) (unitVar1) = Operators.op_Addition (Operators.op_Addition (__.compiledAsField,let x: Microsoft.FSharp.Core.int = __.compiledAsField in __.compiledAsGenericInstanceMethod(x)),__.compiledAsArg) @ (55,21--55,102)"; "member M2(__) (unitVar1) = __.compiledAsInstanceMethod(()) @ (56,21--56,47)"; @@ -468,7 +468,7 @@ let ``Test Declarations project1`` () = "let quotationTest1(unitVar0) = quote(Operators.op_Addition (1,1)) @ (83,24--83,35)"; "let quotationTest2(v) = quote(Operators.op_Addition (ExtraTopLevelOperators.SpliceExpression (v),1)) @ (84,24--84,36)"; "type RecdType"; "type UnionType"; "type ClassWithEventsAndProperties"; - "member .ctor(unitVar0) = (Object..ctor (); (this.ev <- new FSharpEvent`1(()); ())) @ (89,5--89,33)"; + "member .ctor(unitVar0) = (new Object(); (this.ev <- new FSharpEvent`1(()); ())) @ (89,5--89,33)"; "member .cctor(unitVar) = (sev <- new FSharpEvent`1(()); ()) @ (91,11--91,35)"; "member get_InstanceProperty(x) (unitVar1) = (x.ev.Trigger(1); 1) @ (92,32--92,48)"; "member get_StaticProperty(unitVar0) = (sev.Trigger(1); 1) @ (93,35--93,52)"; @@ -480,14 +480,14 @@ let ``Test Declarations project1`` () = "let functionWithSubmsumption(x) = IntrinsicFunctions.UnboxGeneric (x) @ (102,40--102,52)"; "let functionWithCoercion(x) = Operators.op_PipeRight (Operators.op_PipeRight (IntrinsicFunctions.UnboxGeneric (x :> Microsoft.FSharp.Core.obj),fun x -> M.functionWithSubmsumption (x :> Microsoft.FSharp.Core.obj)),fun x -> M.functionWithSubmsumption (x :> Microsoft.FSharp.Core.obj)) @ (103,39--103,116)"; "type MultiArgMethods"; - "member .ctor(c,d) = (Object..ctor (); ()) @ (105,5--105,20)"; + "member .ctor(c,d) = (new Object(); ()) @ (105,5--105,20)"; "member Method(x) (a,b) = 1 @ (106,37--106,38)"; "member CurriedMethod(x) (a1,b1) (a2,b2) = 1 @ (107,63--107,64)"; "let testFunctionThatCallsMultiArgMethods(unitVar0) = let m: M.MultiArgMethods = new MultiArgMethods(3,4) in Operators.op_Addition (m.Method(7,8),fun tupledArg -> let arg00: Microsoft.FSharp.Core.int = tupledArg.Item0 in let arg01: Microsoft.FSharp.Core.int = tupledArg.Item1 in fun tupledArg -> let arg10: Microsoft.FSharp.Core.int = tupledArg.Item0 in let arg11: Microsoft.FSharp.Core.int = tupledArg.Item1 in m.CurriedMethod(arg00,arg01,arg10,arg11) (9,10) (11,12)) @ (110,8--110,9)"; - "let functionThatUsesObjectExpression(unitVar0) = { Object..ctor () with member x.ToString(unitVar1) = Operators.ToString (888) } @ (114,3--114,55)"; - "let functionThatUsesObjectExpressionWithInterfaceImpl(unitVar0) = { Object..ctor () with member x.ToString(unitVar1) = Operators.ToString (888) interface System.IComparable with member x.CompareTo(y) = 0 } :> System.IComparable @ (117,3--120,38)"; + "let functionThatUsesObjectExpression(unitVar0) = { new Object() with member x.ToString(unitVar1) = Operators.ToString (888) } @ (114,3--114,55)"; + "let functionThatUsesObjectExpressionWithInterfaceImpl(unitVar0) = { new Object() with member x.ToString(unitVar1) = Operators.ToString (888) interface System.IComparable with member x.CompareTo(y) = 0 } :> System.IComparable @ (117,3--120,38)"; "let testFunctionThatUsesUnitsOfMeasure(x) (y) = Operators.op_Addition,Microsoft.FSharp.Core.float<'u>,Microsoft.FSharp.Core.float<'u>> (x,y) @ (122,70--122,75)"; - "let testFunctionThatUsesAddressesAndByrefs(x) = let mutable w: Microsoft.FSharp.Core.int = 4 in let y1: Microsoft.FSharp.Core.byref = x in let y2: Microsoft.FSharp.Core.byref = &w in let arr: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.[] = [| ... |] in let r: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.ref = Operators.Ref (3) in let y3: Microsoft.FSharp.Core.byref = [I_ldelema (NormalAddress,false,ILArrayShape [(Some 0, null)],TypeVar 0us)](arr,0) in let y4: Microsoft.FSharp.Core.byref = &r.contents in let z: Microsoft.FSharp.Core.int = Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (x,y1),y2),y3) in (w <- 3; (x <- 4; (y2 <- 4; (y3 <- 5; Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (z,x),y1),y2),y3),y4),IntrinsicFunctions.GetArray (arr,0)),r.contents))))) @ (125,16--125,17)"; + "let testFunctionThatUsesAddressesAndByrefs(x) = let mutable w: Microsoft.FSharp.Core.int = 4 in let y1: Microsoft.FSharp.Core.byref = x in let y2: Microsoft.FSharp.Core.byref = &w in let arr: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.[] = [| ... |] in let r: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.ref = Operators.Ref (3) in let y3: Microsoft.FSharp.Core.byref = [I_ldelema (NormalAddress,false,ILArrayShape [(Some 0, null)],TypeVar 0us)](arr,0) in let y4: Microsoft.FSharp.Core.byref = &r.contents in let z: Microsoft.FSharp.Core.int = Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (x,y1),y2),y3) in (w <- 3; (x <- 4; (y2 <- 4; (y3 <- 5; Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (Operators.op_Addition (z,x),y1),y2),y3),y4),IntrinsicFunctions.GetArray (arr,0)),r.contents))))) @ (125,16--125,17)"; "let testFunctionThatUsesStructs1(dt) = dt.AddDays(3) @ (139,57--139,72)"; "let testFunctionThatUsesStructs2(unitVar0) = let dt1: System.DateTime = DateTime.get_Now () in let mutable dt2: System.DateTime = DateTime.get_Now () in let dt3: System.TimeSpan = Operators.op_Subtraction (dt1,dt2) in let dt4: System.DateTime = dt1.AddDays(3) in let dt5: Microsoft.FSharp.Core.int = dt1.get_Millisecond() in let dt6: Microsoft.FSharp.Core.byref = &dt2 in let dt7: System.TimeSpan = Operators.op_Subtraction (dt6,dt4) in dt7 @ (142,7--142,10)"; "let testFunctionThatUsesWhileLoop(unitVar0) = let mutable x: Microsoft.FSharp.Core.int = 1 in (while Operators.op_LessThan (x,100) do x <- Operators.op_Addition (x,1) done; x) @ (152,15--152,16)"; @@ -506,7 +506,7 @@ let ``Test Declarations project1`` () = "let g = let x: Microsoft.FSharp.Core.int = 1 in fun y -> M.f (x,y) @ (208,8--208,11)"; "let h = Operators.op_Addition (M.g () 2,3) @ (209,8--209,17)"; "type TestFuncProp"; - "member .ctor(unitVar0) = (Object..ctor (); ()) @ (211,5--211,17)"; + "member .ctor(unitVar0) = (new Object(); ()) @ (211,5--211,17)"; "member get_Id(this) (unitVar1) = fun x -> x @ (212,21--212,31)"; "let wrong = Operators.op_Equality (new TestFuncProp(()).get_Id(()) 0,0) @ (214,12--214,35)"; "let start(name) = (name,name) @ (217,4--217,14)"; @@ -727,7 +727,6 @@ let BigSequenceExpression(outFileOpt,docFileOpt,baseAddressOpt) = let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - [] let ``Test expressions of declarations stress big expressions`` () = let wholeProjectResults = checker.ParseAndCheckProject(ProjectStressBigExpressions.options) |> Async.RunSynchronously @@ -740,11 +739,6 @@ let ``Test expressions of declarations stress big expressions`` () = // This should not stack overflow printDeclarations None (List.ofSeq file1.Declarations) |> Seq.toList |> ignore - -#if SELF_HOST_STRESS - -#if FX_ATLEAST_45 - [] let ``Check use of type provider that provides calls to F# code`` () = let config = @@ -776,21 +770,48 @@ let ``Check use of type provider that provides calls to F# code`` () = results |> shouldEqual ["type TestProject"; "type AssemblyInfo"; "type TestProject"; "type T"; """type Class1"""; - """member .ctor(unitVar0) = (Object..ctor (); ()) @ (5,5--5,11)"""; - """member get_X1(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothing () @ (6,21--6,36)"""; - """member get_X2(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGeneric (3) @ (7,21--7,43)"""; - """member get_X3(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingOneArg (3) @ (8,21--8,42)"""; - """member get_X4(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothing () @ (9,21--9,41)"""; - """member get_X5(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingGeneric (3) @ (10,21--10,48)"""; - """member get_X6(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingOneArg (3) @ (11,21--11,47)"""; - """member get_X7(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingTwoArg (new C(),3) @ (12,21--12,47)"""; - """member get_X8(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothing() @ (13,21--13,49)"""; - """member get_X9(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingGeneric(3) @ (14,21--14,56)"""; - """member get_X10(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingOneArg(3) @ (15,22--15,56)"""; - """member get_X11(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingTwoArg(new C(),3) @ (16,22--16,56)"""; - """member get_X12(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothing () @ (17,22--17,49)"""; - """member get_X13(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingOneArg (3) @ (18,22--18,55)"""; - """member get_X14(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingTwoArg (new C(),3) @ (19,22--19,55)"""] + """member .ctor(unitVar0) = (new Object(); ()) @ (5,5--5,11)"""; + """member get_X1(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothing () @ (6,21--6,36)""" + """member get_X2(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGeneric (3) @ (7,21--7,43)""" + """member get_X3(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingOneArg (3) @ (8,21--8,42)""" + """member get_X4(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothing () @ (9,21--9,41)""" + """member get_X5(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingGeneric (3) @ (10,21--10,48)""" + """member get_X6(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingOneArg (3) @ (11,21--11,47)""" + """member get_X7(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingTwoArg (new C(),3) @ (12,21--12,47)""" + """member get_X8(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothing() @ (13,21--13,49)""" + """member get_X9(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingGeneric(3) @ (14,21--14,56)""" + """member get_X10(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingOneArg(3) @ (15,22--15,56)""" + """member get_X11(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingTwoArg(new C(),3) @ (16,22--16,56)""" + """member get_X12(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothing () @ (17,22--17,49)""" + """member get_X13(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingOneArg (3) @ (18,22--18,55)""" + """member get_X14(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingTwoArg (new C(),3) @ (19,22--19,55)""" + """member get_X15(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in let matchValue: Microsoft.FSharp.Core.Option = FSharpOption`1.Some (1) in (if Operators.op_Equality (matchValue.Tag,1) then let x: Microsoft.FSharp.Core.int = matchValue.get_Value() in x else 0) @ (20,22--20,54)""" + """member get_X17(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in let r: TestTP.Helper.R = new R(1,0) in (r.B <- 1; r.A) @ (22,22--22,60)""" + """member get_X18(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingTwoArg (3,4) @ (23,22--23,43)""" + """member get_X19(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingTwoArgCurried (3,4) @ (24,22--24,50)""" + """member get_X21(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in (fun arg00 -> fun arg10 -> C.DoNothingTwoArgCurried (arg00,arg10) new C()) 3 @ (25,22--25,55)""" + """member get_X23(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in (let objectArg: TestTP.Helper.C = new C() in fun arg00 -> fun arg10 -> objectArg.InstanceDoNothingTwoArgCurried(arg00,arg10) new C()) 3 @ (26,22--26,63)""" + """member get_X24(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGenericWithConstraint (3) @ (27,22--27,58)""" + """member get_X25(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGenericWithTypeConstraint,Microsoft.FSharp.Core.int> (FSharpList`1.Cons (3,FSharpList`1.get_Empty ())) @ (28,22--28,62)""" + """member get_X26(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGenericWithTypeConstraint,Microsoft.FSharp.Core.int> (FSharpList`1.Cons (3,FSharpList`1.get_Empty ())) @ (29,22--29,62)""" + """member get_X27(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.DoNothingReally () @ (30,22--30,53)""" + """member get_X28(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new CSharpClass(0).Method("x") :> Microsoft.FSharp.Core.Unit @ (31,22--31,40)""" + """member get_X29(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Operators.op_Addition (new CSharpClass(0).Method2("x"),new CSharpClass(0).Method2("empty")) :> Microsoft.FSharp.Core.Unit @ (32,22--32,53)""" + """member get_X30(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new CSharpClass(0).Method3([| ... |]) :> Microsoft.FSharp.Core.Unit @ (33,22--33,50)""" + """member get_X31(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new CSharpClass(0).GenericMethod(2) @ (34,22--34,47)""" + """member get_X32(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new CSharpClass(0).GenericMethod2(new Object()) @ (35,22--35,61)""" + """member get_X33(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new CSharpClass(0).GenericMethod3(3) @ (36,22--36,65)""" + """member get_X34(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingReally () @ (37,22--37,58)""" + """member get_X35(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().DoNothingReallyInst() @ (38,22--38,66)""" + """member get_X36(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in (new CSharpClass(0) :> FSharp.Compiler.Service.Tests.ICSharpExplicitInterface).ExplicitMethod("x") :> Microsoft.FSharp.Core.Unit @ (39,22--39,62)""" + """member get_X37(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in (new C() :> TestTP.Helper.I).DoNothing() @ (40,22--40,46)""" + """member get_X38(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().VirtualDoNothing() @ (41,22--41,45)""" + ] + + +#if SELF_HOST_STRESS + +#if FX_ATLEAST_45 #endif diff --git a/tests/service/FSharp.Compiler.Service.Tests.fsproj b/tests/service/FSharp.Compiler.Service.Tests.fsproj index 178fab3b46..0d2ad6bb97 100644 --- a/tests/service/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/service/FSharp.Compiler.Service.Tests.fsproj @@ -99,6 +99,11 @@ {887630a3-4b1d-40ea-b8b3-2d842e9c40db} True + + TestTP + {ff76bd3c-5e0a-4752-b6c3-044f6e15719b} + True + diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index fda86f6a0a..14fc814b92 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -4786,11 +4786,11 @@ let ``Test project38 abstract slot information`` () = "Method", ["type OverrideTests.B<'YY> original generics: <'Y> with member Method : () -> Microsoft.FSharp.Core.unit"] "OverrideTests-I`1-Method", ["type OverrideTests.I<'XX> original generics: <'X> with member Method : () -> Microsoft.FSharp.Core.unit"] "NotOverride", [] - "add_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member add_Event : Microsoft.FSharp.Control.Handler -> Microsoft.FSharp.Core.unit"] + "add_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member add_Event : Microsoft.FSharp.Control.Handler -> Microsoft.FSharp.Core.unit"] "get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"] "get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"] "OverrideTests-I`1-get_Property", ["type OverrideTests.I<'XX> original generics: <'X> with member get_Property : () -> Microsoft.FSharp.Core.int"] - "remove_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member remove_Event : Microsoft.FSharp.Control.Handler -> Microsoft.FSharp.Core.unit"] + "remove_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member remove_Event : Microsoft.FSharp.Control.Handler -> Microsoft.FSharp.Core.unit"] "get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"] "get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"] |] diff --git a/tests/service/ProjectOptionsTests.fs b/tests/service/ProjectOptionsTests.fs index d56d9de02c..cc498a074d 100644 --- a/tests/service/ProjectOptionsTests.fs +++ b/tests/service/ProjectOptionsTests.fs @@ -386,20 +386,20 @@ let ``Project file parsing -- Exe with a PCL reference``() = [] let ``Project file parsing -- project file contains project reference to out-of-solution project and is used in release mode``() = - let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fsproj") + let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/Test2.fsproj") let p = ProjectCracker.GetProjectOptionsFromProjectFile(f,[("Configuration","Release")]) let references = getReferencedFilenamesAndContainingFolders p.OtherOptions |> set // Check the reference is to a release DLL - references |> should contain ("TestTP.dll", "Release") + references |> should contain ("Test1.dll", "Release") [] let ``Project file parsing -- project file contains project reference to out-of-solution project and is used in debug mode``() = - let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fsproj") + let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/Test2.fsproj") let p = ProjectCracker.GetProjectOptionsFromProjectFile(f,[("Configuration","Debug")]) let references = getReferencedFilenamesAndContainingFolders p.OtherOptions |> set // Check the reference is to a debug DLL - references |> should contain ("TestTP.dll", "Debug") + references |> should contain ("Test1.dll", "Debug") [] let ``Project file parsing -- space in file name``() = diff --git a/tests/service/data/CSharp_Analysis/CSharpClass.cs b/tests/service/data/CSharp_Analysis/CSharpClass.cs index dfd171fbde..fbef78388a 100644 --- a/tests/service/data/CSharp_Analysis/CSharpClass.cs +++ b/tests/service/data/CSharp_Analysis/CSharpClass.cs @@ -1,6 +1,7 @@ using System; using System.Collections.Generic; using System.Linq; +using System.Runtime.InteropServices; using System.Text; using System.Threading.Tasks; @@ -51,6 +52,31 @@ public int Method(string parameter) throw new NotImplementedException(); } + public int Method2(string optParameter = "empty") + { + throw new NotImplementedException(); + } + + public int Method3(params string[] variadicParameter) + { + throw new NotImplementedException(); + } + + public void GenericMethod(T input) + { + throw new NotImplementedException(); + } + + public void GenericMethod2(T input) where T : class + { + throw new NotImplementedException(); + } + + public void GenericMethod3(T input) where T : IComparable + { + throw new NotImplementedException(); + } + public bool Property { get { throw new NotImplementedException(); } @@ -58,7 +84,6 @@ public bool Property public event EventHandler Event; - public int InterfaceMethod(string parameter) { throw new NotImplementedException(); diff --git a/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj b/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj index e30151da02..8757073bff 100644 --- a/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj +++ b/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj @@ -9,7 +9,7 @@ Properties CSharp_Analysis CSharp_Analysis - v4.0 + v4.5 ..\..\..\..\ ..\..\..\..\bin\$(TargetFrameworkVersion)\ 512 diff --git a/tests/service/data/TestProject/Library.fs b/tests/service/data/TestProject/Library.fs index 5983364772..6e7c842908 100644 --- a/tests/service/data/TestProject/Library.fs +++ b/tests/service/data/TestProject/Library.fs @@ -17,6 +17,25 @@ type Class1() = member this.X12 = T().GenericClassDoNothing() member this.X13 = T().GenericClassDoNothingOneArg() member this.X14 = T().GenericClassDoNothingTwoArg() - - - + member this.X15 = T().OptionConstructionAndMatch() +// member this.X16 = T().ChoiceConstructionAndMatch() + member this.X17 = T().RecordConstructionAndFieldGetSet() + member this.X18 = T().DoNothingTwoArg() + member this.X19 = T().DoNothingTwoArgCurried() + member this.X21 = T().ClassDoNothingTwoArgCurried() + member this.X23 = T().ClassInstanceDoNothingTwoArgCurried() + member this.X24 = T().DoNothingGenericWithConstraint() + member this.X25 = T().DoNothingGenericWithTypeConstraint() + member this.X26 = T().DoNothingGenericWithTypeConstraint() + member this.X27 = T().DoNothingWithCompiledName() + member this.X28 = T().CSharpMethod() + member this.X29 = T().CSharpMethodOptionalParam() + member this.X30 = T().CSharpMethodParamArray() + member this.X31 = T().CSharpMethodGeneric() + member this.X32 = T().CSharpMethodGenericWithConstraint() + member this.X33 = T().CSharpMethodGenericWithTypeConstraint() + member this.X34 = T().ClassDoNothingWithCompiledName() + member this.X35 = T().ClassInstanceDoNothingWithCompiledName() + member this.X36 = T().CSharpExplicitImplementationMethod() + member this.X37 = T().InterfaceDoNothing() + member this.X38 = T().OverrideDoNothing() diff --git a/tests/service/data/TestProject/TestProject.fsproj b/tests/service/data/TestProject/TestProject.fsproj index cdbf99c0d9..10a06dea5c 100644 --- a/tests/service/data/TestProject/TestProject.fsproj +++ b/tests/service/data/TestProject/TestProject.fsproj @@ -47,6 +47,11 @@ + + CSharp_Analysis + {887630a3-4b1d-40ea-b8b3-2d842e9c40db} + True + TestTP {ff76bd3c-5e0a-4752-b6c3-044f6e15719b} diff --git a/tests/service/data/TestTP/Library.fs b/tests/service/data/TestTP/Library.fs index 7530913eb4..76c5242a8f 100644 --- a/tests/service/data/TestTP/Library.fs +++ b/tests/service/data/TestTP/Library.fs @@ -7,16 +7,43 @@ open System.Reflection module Helper = let doNothing() = () let doNothingOneArg(x:int) = () + let doNothingTwoArg(x:int, y: int) = () + let doNothingTwoArgCurried(x:int) (y: int) = () + [] + let doNothingWithCompiledName() = () let doNothingGeneric(x:'T) = () + let doNothingGenericWithConstraint(x: 'T when 'T: equality) = () + let doNothingGenericWithTypeConstraint(x: 'T when 'T :> _ seq) = () + + type I = + abstract DoNothing: unit -> unit + + type B() = + abstract VirtualDoNothing: unit -> unit + default this.VirtualDoNothing() = () + type C() = + inherit B() static member DoNothing() = () static member DoNothingOneArg(x:int) = () + static member DoNothingOneArg(x:string) = () static member DoNothingTwoArg(c:C, x:int) = () + static member DoNothingTwoArgCurried (c:C) (x:int) = () static member DoNothingGeneric(x:'T) = () + [] + static member DoNothingWithCompiledName() = () member __.InstanceDoNothing() = () member __.InstanceDoNothingOneArg(x:int) = () + member __.InstanceDoNothingOneArg(x:string) = () member __.InstanceDoNothingTwoArg(c:C, x:int) = () + member __.InstanceDoNothingTwoArgCurried(c:C) (x:int) = () member __.InstanceDoNothingGeneric(x:'T) = () + [] + member __.InstanceDoNothingWithCompiledName() = () + override __.VirtualDoNothing() = () + + interface I with + member this.DoNothing() = () type G<'U>() = static member DoNothing() = () @@ -28,10 +55,26 @@ module Helper = member __.InstanceDoNothingTwoArg(c:C, x:int) = () member __.InstanceDoNothingGeneric(x:'U) = () + type R = { A : int; mutable B : int } + +open FSharp.Compiler.Service.Tests + [] type BasicProvider (config : TypeProviderConfig) as this = inherit TypeProviderForNamespaces () + // resolve CSharp_Analysis from referenced assemblies + do System.AppDomain.CurrentDomain.add_AssemblyResolve(fun _ args -> + let name = AssemblyName(args.Name).Name.ToLowerInvariant() + let an = + config.ReferencedAssemblies + |> Seq.tryFind (fun an -> + System.IO.Path.GetFileNameWithoutExtension(an).ToLowerInvariant() = name) + match an with + | Some f -> Assembly.LoadFrom f + | None -> null + ) + let ns = "ErasedWithConstructor.Provided" let asm = Assembly.GetExecutingAssembly() @@ -58,10 +101,30 @@ type BasicProvider (config : TypeProviderConfig) as this = InvokeCode = fun args -> <@@ Helper.doNothingOneArg(3) @@>) myType.AddMember(someMethod) + let someMethod = ProvidedMethod("DoNothingTwoArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingTwoArg(3, 4) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("DoNothingTwoArgCurried", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingTwoArgCurried 3 4 @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("DoNothingWithCompiledName", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingWithCompiledName() @@>) + myType.AddMember(someMethod) + let someMethod = ProvidedMethod("DoNothingGeneric", [], typeof, InvokeCode = fun args -> <@@ Helper.doNothingGeneric(3) @@>) myType.AddMember(someMethod) + let someMethod = ProvidedMethod("DoNothingGenericWithConstraint", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingGenericWithConstraint(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("DoNothingGenericWithTypeConstraint", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingGenericWithTypeConstraint([3]) @@>) + myType.AddMember(someMethod) + let someMethod = ProvidedMethod("ClassDoNothing", [], typeof, InvokeCode = fun args -> <@@ Helper.C.DoNothing() @@>) myType.AddMember(someMethod) @@ -80,6 +143,14 @@ type BasicProvider (config : TypeProviderConfig) as this = InvokeCode = fun args -> <@@ Helper.C.DoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) + let someMethod = ProvidedMethod("ClassDoNothingTwoArgCurried", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothingTwoArgCurried (Helper.C()) 3 @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassDoNothingWithCompiledName", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothingWithCompiledName() @@>) + myType.AddMember(someMethod) + let someMethod = ProvidedMethod("ClassInstanceDoNothing", [], typeof, InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothing() @@>) myType.AddMember(someMethod) @@ -96,6 +167,22 @@ type BasicProvider (config : TypeProviderConfig) as this = InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) + let someMethod = ProvidedMethod("ClassInstanceDoNothingTwoArgCurried", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArgCurried (Helper.C()) 3 @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassInstanceDoNothingWithCompiledName", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingWithCompiledName() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("InterfaceDoNothing", [], typeof, + InvokeCode = fun args -> <@@ (Helper.C() :> Helper.I).DoNothing() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("OverrideDoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().VirtualDoNothing() @@>) + myType.AddMember(someMethod) + let someMethod = ProvidedMethod("GenericClassDoNothing", [], typeof, InvokeCode = fun args -> <@@ Helper.G.DoNothing() @@>) myType.AddMember(someMethod) @@ -118,7 +205,6 @@ type BasicProvider (config : TypeProviderConfig) as this = InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothing() @@>) myType.AddMember(someMethod) - let someMethod = ProvidedMethod("GenericClassInstanceDoNothingOneArg", [], typeof, InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingOneArg(3) @@>) myType.AddMember(someMethod) @@ -127,7 +213,47 @@ type BasicProvider (config : TypeProviderConfig) as this = InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) - [myType] + let someMethod = ProvidedMethod("OptionConstructionAndMatch", [], typeof, + InvokeCode = fun args -> <@@ match Some 1 with None -> 0 | Some x -> x @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ChoiceConstructionAndMatch", [], typeof, + InvokeCode = fun args -> <@@ match Choice1Of2 1 with Choice2Of2 _ -> 0 | Choice1Of2 x -> x @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("RecordConstructionAndFieldGetSet", [], typeof, + InvokeCode = fun args -> <@@ let r : Helper.R = { A = 1; B = 0 } in r.B <- 1; r.A @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethod", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).Method("x") @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethodOptionalParam", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).Method2("x") + CSharpClass(0).Method2() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethodParamArray", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).Method3("x", "y") @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethodGeneric", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod(2) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethodGenericWithConstraint", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod2(obj()) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpMethodGenericWithTypeConstraint", [], typeof, + InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod3(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("CSharpExplicitImplementationMethod", [], typeof, + InvokeCode = fun args -> <@@ (CSharpClass(0) :> ICSharpExplicitInterface).ExplicitMethod("x") @@>) + myType.AddMember(someMethod) + + [myType] do this.AddNamespace(ns, createTypes()) diff --git a/tests/service/data/TestTP/TestTP.fsproj b/tests/service/data/TestTP/TestTP.fsproj index 2c26ce9fe1..dabc70aad5 100644 --- a/tests/service/data/TestTP/TestTP.fsproj +++ b/tests/service/data/TestTP/TestTP.fsproj @@ -13,6 +13,7 @@ true 4.3.0.0 TestTP + ..\..\..\..\bin\$(TargetFrameworkVersion)\ @@ -20,7 +21,6 @@ full false false - bin\Debug\ DEBUG;TRACE 3 AnyCPU @@ -31,7 +31,6 @@ pdbonly true true - bin\Release\ TRACE 3 AnyCPU @@ -68,6 +67,13 @@ + + + CSharp_Analysis + {887630a3-4b1d-40ea-b8b3-2d842e9c40db} + True + +