diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 63f244fc26b..1872aaeca3b 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1186,7 +1186,7 @@ module MutRecBindingChecking = // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call | Phase2AInherit (synBaseTy, arg, baseValOpt, m) -> - let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy + let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envInstance tpenv synBaseTy let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g let inheritsExpr, tpenv = try diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c1cc0f1a49e..0bf669b0f66 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1694,7 +1694,7 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> member _.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports member _.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = - notifyNameResolution (pos, item, item, itemTyparInst, occurence, nenv, ad, m, replacing) + notifyNameResolution (pos, item, item, itemTyparInst, occurence, nenv, ad, m, Option.isSome replacing) member _.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) @@ -4440,7 +4440,7 @@ and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tp | _, TyparKind.Measure -> TType_measure (Measure.Const tcref), tpenv | _, TyparKind.Type -> - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing [] + TcTypeApp cenv newOk checkConstraints occ env tpenv m m tcref tinstEnclosing [] /// Some.Long.TypeName /// ty1 SomeLongTypeName @@ -4467,7 +4467,7 @@ and TcLongIdentAppType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env | _, TyparKind.Type -> if postfix && tcref.Typars m |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing args + TcTypeApp cenv newOk checkConstraints occ env tpenv longId.Range m tcref tinstEnclosing args | _, TyparKind.Measure -> match args, postfix with @@ -4487,7 +4487,7 @@ and TcNestedAppType (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synL match leftTy with | AppTy g (tcref, tinst) -> let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinst args + TcTypeApp cenv newOk checkConstraints occ env tpenv synLongId.Range m tcref tinst args | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), m)) @@ -4862,22 +4862,27 @@ and TcProvidedMethodAppToStaticConstantArgs (cenv: cenv) env tpenv (minfo, methB providedMethAfterStaticArguments -and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m = - let hasNoArgs, providedTypeAfterStaticArguments, checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv env None tpenv tcref args m +and TcProvidedTypeApp (cenv: cenv) occ env tpenv tcref args mItem mWhole = + let hasNoArgs, providedTypeAfterStaticArguments, checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv env None tpenv tcref args mWhole - let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased), m) + let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased), mWhole) //printfn "adding entity for provided type '%s', isDirectReferenceToGenerated = %b, isGenerated = %b" (st.PUntaint((fun st -> st.Name), m)) isDirectReferenceToGenerated isGenerated - let isDirectReferenceToGenerated = isGenerated && IsGeneratedTypeDirectReference (providedTypeAfterStaticArguments, m) + let isDirectReferenceToGenerated = isGenerated && IsGeneratedTypeDirectReference (providedTypeAfterStaticArguments, mWhole) if isDirectReferenceToGenerated then - error(Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m)) + error(Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), mWhole)) // We put the type name check after the 'isDirectReferenceToGenerated' check because we need the 'isDirectReferenceToGenerated' error to be shown for generated types checkTypeName() if hasNoArgs then mkAppTy tcref [], tpenv else - let ty = Import.ImportProvidedType cenv.amap m providedTypeAfterStaticArguments + let ty = Import.ImportProvidedType cenv.amap mWhole providedTypeAfterStaticArguments + + if not hasNoArgs then + let item = Item.Types(tcref.DisplayNameCore, [ty]) + CallNameResolutionSinkReplacing cenv.tcSink (function Item.CtorGroup _ -> false | _ -> true) (mItem, env.NameEnv, item, getInst ty, occ, env.eAccessRights) + ty, tpenv #endif @@ -4886,18 +4891,18 @@ and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m = /// Note that the generic type may be a nested generic type List.ListEnumerator. /// In this case, 'argsR is only the instantiation of the suffix type arguments, and pathTypeArgs gives /// the prefix of type arguments. -and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathTypeArgs (synArgTys: SynType list) = +and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv mItem mWhole tcref pathTypeArgs (synArgTys: SynType list) = let g = cenv.g - CheckTyconAccessible cenv.amap m env.AccessRights tcref |> ignore - CheckEntityAttributes g tcref m |> CommitOperationResult + CheckTyconAccessible cenv.amap mWhole env.AccessRights tcref |> ignore + CheckEntityAttributes g tcref mWhole |> CommitOperationResult #if !NO_TYPEPROVIDERS // Provided types are (currently) always non-generic. Their names may include mangled // static parameters, which are passed by the provider. - if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else + if tcref.Deref.IsProvided then TcProvidedTypeApp cenv occ env tpenv tcref synArgTys mItem mWhole else #endif - let tps, _, tinst, _ = FreshenTyconRef2 g m tcref + let tps, _, tinst, _ = FreshenTyconRef2 g mItem tcref // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. @@ -4905,23 +4910,27 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType let synArgTysLength = synArgTys.Length let pathTypeArgsLength = pathTypeArgs.Length if tinst.Length <> pathTypeArgsLength + synArgTysLength then - error (TyconBadArgs(env.DisplayEnv, tcref, pathTypeArgsLength + synArgTysLength, m)) + error (TyconBadArgs(env.DisplayEnv, tcref, pathTypeArgsLength + synArgTysLength, mWhole)) let argTys, tpenv = // Get the suffix of typars let tpsForArgs = List.skip (tps.Length - synArgTysLength) tps let kindsForArgs = tpsForArgs |> List.map (fun tp -> tp.Kind) - TcTypesOrMeasures (Some kindsForArgs) cenv newOk checkConstraints occ env tpenv synArgTys m + TcTypesOrMeasures (Some kindsForArgs) cenv newOk checkConstraints ItemOccurence.UseInType env tpenv synArgTys mWhole // Add the types of the enclosing class for a nested type let actualArgTys = pathTypeArgs @ argTys if checkConstraints = CheckCxs then - List.iter2 (UnifyTypes cenv env m) tinst actualArgTys + List.iter2 (UnifyTypes cenv env mWhole) tinst actualArgTys // Try to decode System.Tuple --> F# tuple types etc. let ty = g.decompileType tcref actualArgTys + if not actualArgTys.IsEmpty then + let item = Item.Types(tcref.DisplayNameCore, [ty]) + CallNameResolutionSinkReplacing cenv.tcSink (function Item.CtorGroup _ -> false | _ -> true) (mItem, env.NameEnv, item, getInst ty, occ, env.eAccessRights) + ty, tpenv and TcTypeOrMeasureAndRecover kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tpenv ty = @@ -4943,7 +4952,7 @@ and TcTypeOrMeasureAndRecover kindOpt (cenv: cenv) newOk checkConstraints occ iw and TcTypeAndRecover (cenv: cenv) newOk checkConstraints occ iwsam env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkConstraints occ iwsam env tpenv ty -and TcNestedTypeApplication (cenv: cenv) newOk checkConstraints occ iwsam env tpenv mWholeTypeApp ty pathTypeArgs tyargs = +and TcNestedTypeApplication (cenv: cenv) newOk checkConstraints occ iwsam env tpenv mItem mWholeTypeApp ty pathTypeArgs tyargs = let g = cenv.g let ty = convertToTypeWithMetadataIfPossible g ty @@ -4954,7 +4963,7 @@ and TcNestedTypeApplication (cenv: cenv) newOk checkConstraints occ iwsam env tp match ty with | TType_app(tcref, _, _) -> CheckIWSAM cenv env checkConstraints iwsam mWholeTypeApp tcref - TcTypeApp cenv newOk checkConstraints occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs + TcTypeApp cenv newOk checkConstraints occ env tpenv mItem mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -5253,7 +5262,7 @@ and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = | Some {contents = SynSimplePatAlternativeIdInfo.Decided altId} -> TcExprThen cenv overallTy env tpenv isArg (SynExpr.LongIdent (isOpt, SynLongIdent([altId], [], [None]), None, mLongId)) delayed | _ -> - TcLongIdentThen cenv overallTy env tpenv longId delayed + TcLongIdentThen cenv overallTy ItemOccurence.Use env tpenv longId delayed // f?x<-v | SynExpr.Set(SynExpr.Dynamic(e1, _, e2, _) , rhsExpr, m) -> @@ -5605,7 +5614,7 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE TcExprArrayOrList cenv overallTy env tpenv (isArray, args, m) | SynExpr.New (superInit, synObjTy, arg, mNewExpr) -> - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synObjTy TcNonControlFlowExpr env <| fun env -> TcPropagatingExprLeafThenConvert cenv overallTy objTy env (* true *) mNewExpr (fun () -> @@ -6076,11 +6085,11 @@ and TcExprDotNamedIndexedPropertySet (cenv: cenv) overallTy env tpenv (synExpr1, MakeDelayedSet(expr3, mStmt)] and TcExprLongIdentSet (cenv: cenv) overallTy env tpenv (synLongId, synExpr2, m) = - TcLongIdentThen cenv overallTy env tpenv synLongId [ MakeDelayedSet(synExpr2, m) ] + TcLongIdentThen cenv overallTy ItemOccurence.Use env tpenv synLongId [ MakeDelayedSet(synExpr2, m) ] // Type.Items(synExpr1) <- synExpr2 and TcExprNamedIndexPropertySet (cenv: cenv) overallTy env tpenv (synLongId, synExpr1, synExpr2, mStmt) = - TcLongIdentThen cenv overallTy env tpenv synLongId + TcLongIdentThen cenv overallTy ItemOccurence.Use env tpenv synLongId [ DelayedApp(ExprAtomicFlag.Atomic, false, None, synExpr1, mStmt) MakeDelayedSet(synExpr2, mStmt) ] @@ -6225,8 +6234,9 @@ and TcTyparExprThen (cenv: cenv) overallTy env tpenv synTypar m delayed = match rest with | [] -> delayed2 | _ -> DelayedDotLookup (rest, m2) :: delayed2 - CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) - TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed3 + let occ = ItemOccurence.Use + CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, occ, env.AccessRights) + TcItemThen cenv overallTy occ env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed3 //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution | _ -> let (SynTypar(_, q, _)) = synTypar @@ -8038,7 +8048,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = | Item.FakeInterfaceCtor _ -> false | _ -> true) -> let overallTy = match overallTyOpt with None -> MustEqual (NewInferenceType g) | Some t -> t - let _, _ = TcItemThen cenv overallTy env tpenv res None delayed + let _, _ = TcItemThen cenv overallTy ItemOccurence.Use env tpenv res None delayed true | _ -> false @@ -8052,7 +8062,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = | Result (tinstEnclosing, tcref) when IsEntityAccessible cenv.amap m ad tcref -> match delayed with | [DelayedTypeApp (tyargs, _, mExprAndTypeArgs)] -> - TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref tinstEnclosing tyargs |> ignore + TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs mExprAndTypeArgs tcref tinstEnclosing tyargs |> ignore | _ -> () true // resolved to a type name, done with checks | _ -> @@ -8239,21 +8249,21 @@ and GetLongIdentTypeNameInfo delayed = | _ -> TypeNameResolutionInfo.Default -and TcLongIdentThen (cenv: cenv) (overallTy: OverallTy) env tpenv (SynLongIdent(longId, _, _)) delayed = +and TcLongIdentThen (cenv: cenv) (overallTy: OverallTy) occ env tpenv (SynLongIdent(longId, _, _)) delayed = let ad = env.eAccessRights let typeNameResInfo = GetLongIdentTypeNameInfo delayed let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId |> ForceRaise - TcItemThen cenv overallTy env tpenv nameResolutionResult None delayed + TcItemThen cenv overallTy occ env tpenv nameResolutionResult None delayed //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen (cenv: cenv) (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) staticTyOpt delayed = +and TcItemThen (cenv: cenv) (overallTy: OverallTy) occ env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) staticTyOpt delayed = let delayed = delayRest rest mItem delayed match item with // x where x is a union case or active pattern result tag. @@ -8261,7 +8271,7 @@ and TcItemThen (cenv: cenv) (overallTy: OverallTy) env tpenv (tinstEnclosing, it TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tpenv mItem delayed | Item.Types(nm, ty :: _) -> - TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed + TcTypeItemThen cenv overallTy occ env nm ty tpenv mItem tinstEnclosing delayed | Item.MethodGroup (methodName, minfos, _) -> TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed @@ -8272,8 +8282,12 @@ and TcItemThen (cenv: cenv) (overallTy: OverallTy) env tpenv (tinstEnclosing, it | Item.CtorGroup(nm, minfos) -> TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed - | Item.FakeInterfaceCtor _ -> - error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(), mItem)) + | Item.FakeInterfaceCtor ty -> + let nm = + match ty with + | TType_app(tcref, _, _) -> tcref.DisplayNameCore + | _ -> NicePrint.minimalStringOfType env.DisplayEnv ty + TcTypeItemThen cenv overallTy occ env nm ty tpenv mItem tinstEnclosing delayed | Item.ImplicitOp(id, sln) -> TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed @@ -8482,37 +8496,49 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env let exprTy = tyOfExpr g expr PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed -and TcTypeItemThen (cenv: cenv) overallTy env nm ty tpenv mItem tinstEnclosing delayed = +and TcTypeItemThen (cenv: cenv) overallTy occ env nm ty tpenv mItem tinstEnclosing delayed = let g = cenv.g let ad = env.eAccessRights + + // In this case the type is not generic, and indeed we should never have returned Item.Types. + // That's because ResolveTypeNamesToCtors should have been set at the original + // call to ResolveLongIdentAsExprAndComputeRange + let reportWrongTypeUsageError ty m _mWithArgs = + if isInterfaceTy g ty then + error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(), m)) + else + error(Error(FSComp.SR.tcInvalidUseOfTypeName(), m)) + + let reportTypeUsage ty m replacing = + let item = Item.Types(nm, [ty]) + let filter = (function Item.CtorGroup _ -> false | _ -> true) + if replacing then + CallNameResolutionSinkReplacing cenv.tcSink filter (m, env.NameEnv, item, getInst ty, occ, env.eAccessRights) + else + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, getInst ty, occ, env.eAccessRights) + match delayed with | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedDotLookup (longId, mLongId) :: otherDelayed -> // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs - - // Report information about the whole expression including type arguments to VS - let item = Item.Types(nm, [ty]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs occ WarnOnIWSAM.Yes env tpenv mItem mExprAndTypeArgs ty tinstEnclosing tyargs + reportTypeUsage ty mExprAndTypeArgs false let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true - TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) None otherDelayed + TcItemThen cenv overallTy occ env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) None otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> - // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs - let item = Item.Types(nm, [ty]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + reportTypeUsage ty mItem true + reportTypeUsage ty mExprAndTypeArgs false - // Same error as in the following case - error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs occ WarnOnIWSAM.Yes env tpenv mItem mExprAndTypeArgs ty tinstEnclosing tyargs + reportWrongTypeUsageError ty mItem mExprAndTypeArgs | _ -> - // In this case the type is not generic, and indeed we should never have returned Item.Types. - // That's because ResolveTypeNamesToCtors should have been set at the original - // call to ResolveLongIdentAsExprAndComputeRange - error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) + reportTypeUsage ty mItem true + reportWrongTypeUsageError ty mItem mItem and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed = let ad = env.eAccessRights @@ -8530,7 +8556,7 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt // Replace the resolution including the static parameters, plus the extra information about the original method info let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) - CallNameResolutionSinkReplacing cenv.tcSink (mItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSinkReplacing cenv.tcSink (fun _ -> true) (mItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> @@ -8578,7 +8604,7 @@ and TcCtorItemThen (cenv: cenv) overallTy env item nm minfos tinstEnclosing tpen | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItem mExprAndTypeArgs objTy tinstEnclosing tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_TYPEPROVIDERS @@ -8599,7 +8625,7 @@ and TcCtorItemThen (cenv: cenv) overallTy env item nm minfos tinstEnclosing tpen | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItem mExprAndTypeArgs objTy tinstEnclosing tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -8809,7 +8835,7 @@ and TcDelegateCtorItemThen cenv overallTy env ty tinstEnclosing tpenv mItem dela | DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs) :: DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItem mItemAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -9087,7 +9113,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed | Some minfoAfterStaticArguments -> // Replace the resolution including the static parameters, plus the extra information about the original method info let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) - CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) + CallNameResolutionSinkReplacing cenv.tcSink (fun _ -> true) (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed | None -> diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 90340f07b33..6dc4aad1aa5 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1751,7 +1751,7 @@ type ITypecheckResultsSink = abstract NotifyExprHasType: TType * NameResolutionEnv * AccessorDomain * range -> unit - abstract NotifyNameResolution: pos * item: Item * TyparInstantiation * ItemOccurence * NameResolutionEnv * AccessorDomain * range * replace: bool -> unit + abstract NotifyNameResolution: pos * item: Item * TyparInstantiation * ItemOccurence * NameResolutionEnv * AccessorDomain * range * replace: (Item -> bool) option -> unit abstract NotifyMethodGroupNameResolution : pos * item: Item * itemMethodGroup: Item * TyparInstantiation * ItemOccurence * NameResolutionEnv * AccessorDomain * range * replace: bool -> unit @@ -2141,12 +2141,28 @@ type TcResultsSinkImpl(tcGlobals, ?sourceText: ISourceText) = capturedExprTypings.Add((ty, nenv, ad, m)) member sink.NotifyNameResolution(endPos, item, tpinst, occurenceType, nenv, ad, m, replace) = - if allowedRange m then - if replace then - remove m + if isAlreadyDone endPos item m || not (allowedRange m) then () else - if not (isAlreadyDone endPos item m) then - capturedNameResolutions.Add(CapturedNameResolution(item, tpinst, occurenceType, nenv, ad, m)) + let cnr = CapturedNameResolution(item, tpinst, occurenceType, nenv, ad, m) + + match replace with + | None -> + capturedNameResolutions.Add(cnr) + + | Some f -> + match item with + | Item.MethodGroup _ -> + match capturedMethodGroupResolutions.FindLastIndex(fun cnr -> equals cnr.Range m) with + | -1 -> () + | i -> capturedMethodGroupResolutions.RemoveAt(i) + | _ -> () + + match capturedNameResolutions.FindLastIndex(fun cnr -> equals cnr.Range m) with + | i when i >= 0 -> + if f capturedNameResolutions[i].Item then + capturedNameResolutions[i] <- cnr + | _ -> + capturedNameResolutions.Add(cnr) member sink.NotifyMethodGroupNameResolution(endPos, item, itemMethodGroup, tpinst, occurenceType, nenv, ad, m, replace) = if allowedRange m then @@ -2197,17 +2213,17 @@ let CallEnvSink (sink: TcResultsSink) (scopem, nenv, ad) = let CallNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, tpinst, occurenceType, ad) = match sink.CurrentSink with | None -> () - | Some sink -> sink.NotifyNameResolution(m.End, item, tpinst, occurenceType, nenv, ad, m, false) + | Some sink -> sink.NotifyNameResolution(m.End, item, tpinst, occurenceType, nenv, ad, m, None) let CallMethodGroupNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, itemMethodGroup, tpinst, occurenceType, ad) = match sink.CurrentSink with | None -> () | Some sink -> sink.NotifyMethodGroupNameResolution(m.End, item, itemMethodGroup, tpinst, occurenceType, nenv, ad, m, false) -let CallNameResolutionSinkReplacing (sink: TcResultsSink) (m: range, nenv, item, tpinst, occurenceType, ad) = +let CallNameResolutionSinkReplacing (sink: TcResultsSink) f (m: range, nenv, item, tpinst, occurenceType, ad) = match sink.CurrentSink with | None -> () - | Some sink -> sink.NotifyNameResolution(m.End, item, tpinst, occurenceType, nenv, ad, m, true) + | Some sink -> sink.NotifyNameResolution(m.End, item, tpinst, occurenceType, nenv, ad, m, Some f) /// Report a specific expression typing at a source range let CallExprHasTypeSink (sink: TcResultsSink) (m: range, nenv, ty, ad) = diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 0ed9dc1a3e4..a4dd91c9f80 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -484,7 +484,15 @@ type ITypecheckResultsSink = /// Record that a name resolution occurred at a specific location in the source abstract NotifyNameResolution: - pos * Item * TyparInstantiation * ItemOccurence * NameResolutionEnv * AccessorDomain * range * bool -> unit + pos * + Item * + TyparInstantiation * + ItemOccurence * + NameResolutionEnv * + AccessorDomain * + range * + (Item -> bool) option -> + unit /// Record that a method group name resolution occurred at a specific location in the source abstract NotifyMethodGroupNameResolution: @@ -619,7 +627,10 @@ val internal CallMethodGroupNameResolutionSink: /// Report a specific name resolution at a source range, replacing any previous resolutions val internal CallNameResolutionSinkReplacing: - TcResultsSink -> range * NameResolutionEnv * Item * TyparInstantiation * ItemOccurence * AccessorDomain -> unit + TcResultsSink -> + (Item -> bool) -> + range * NameResolutionEnv * Item * TyparInstantiation * ItemOccurence * AccessorDomain -> + unit /// Report a specific name resolution at a source range val internal CallExprHasTypeSink: TcResultsSink -> range * NameResolutionEnv * TType * AccessorDomain -> unit diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index caf5230db20..ae9b3aeda9e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -102,6 +102,12 @@ type ValRemap = ValMap let emptyTyconRefRemap: TyconRefRemap = TyconRefMap<_>.Empty let emptyTyparInst = ([]: TyparInstantiation) +let getInst (ty: TType) = + match stripTyparEqns ty with + | TType_app(tcref, typeArgs, _) -> + List.zip tcref.Deref.TyparsNoRange typeArgs + | _ -> [] + [] type Remap = { tpinst: TyparInstantiation diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index b3e763f9d8a..05a87e243a0 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -567,6 +567,8 @@ val mkTyconRefInst: TyconRef -> TypeInst -> TyparInstantiation val emptyTyparInst: TyparInstantiation +val getInst: TType -> TyparInstantiation + val instType: TyparInstantiation -> TType -> TType val instTypes: TyparInstantiation -> TypeInst -> TypeInst diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 8a68ca6b773..f0bf784ac0c 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -31,21 +31,23 @@ let createProject() = SyntheticProject.Create(impFile()) [] let ``Finding usage of type via GetUsesOfSymbolInFile should also find it's constructors`` () = createProject().Workflow - { + { checkFile "First" (fun (typeCheckResult: FSharpCheckFileResults) -> - + let symbolUse = typeCheckResult.GetSymbolUseAtLocation(7, 11, "type MyType() =", ["MyType"]).Value let references = - typeCheckResult.GetUsesOfSymbolInFile(symbolUse.Symbol) + typeCheckResult.GetUsesOfSymbolInFile(symbolUse.Symbol) |> Array.sortBy (fun su -> su.Range.StartLine) |> Array.map (fun su -> su.Range.StartLine, su.Range.StartColumn, su.Range.EndColumn, deriveOccurence su) - Assert.Equal<(int*int*int*Occurence)>( - [| 7,5,11,Definition - 8,25,31,InType - 10,8,14,Use - 11,12,18,Use - |],references) ) + Assert.Equal( + [| 7, 5, 11, Definition + 8, 25, 31, InType + 10, 8, 14, Use + 11, 12, 18, InType + 11, 12, 18, Use + |], references) + ) } diff --git a/tests/service/CSharpProjectAnalysis.fs b/tests/service/CSharpProjectAnalysis.fs index f23f3038e42..f1f48dcf1f5 100644 --- a/tests/service/CSharpProjectAnalysis.fs +++ b/tests/service/CSharpProjectAnalysis.fs @@ -142,8 +142,7 @@ let _ = CSharpGenericOuterClass.InnerClass.StaticMember() |> shouldEqual [|"FSharp"; "Compiler"; "Service"; "Tests"; "FSharp"; "member .ctor"; "int"; "CSharpGenericOuterClass`1"; "CSharpGenericOuterClass`1"; "int"; - "CSharpGenericOuterClass`1"; "InnerEnum"; "field Case1"; - "CSharpGenericOuterClass`1"; "int"; "CSharpGenericOuterClass`1"; "InnerClass"; + "InnerEnum"; "field Case1"; "CSharpGenericOuterClass`1"; "int"; "InnerClass"; "member StaticMember"; "NestedEnumClass"|] [] diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 4f24b831d2c..7216a0cf13d 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -376,7 +376,7 @@ let inline dumpDiagnostics (results: FSharpCheckFileResults) = |> List.ofArray let getSymbolUses (results: FSharpCheckFileResults) = - results.GetAllUsesOfAllSymbolsInFile() + results.GetAllUsesOfAllSymbolsInFile() |> List.ofSeq let getSymbolUsesFromSource (source: string) = let _, typeCheckResults = getParseAndCheckResults source diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index f7cb93317cc..0960c3769f7 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -355,7 +355,8 @@ let ``Test project1 all uses of all signature symbols`` () = yield s.ToString(), [ for s in wholeProjectResults.GetUsesOfSymbol(s) -> (Project1.cleanFileName s.FileName, tupsZ s.Range) ] ] - let expected = + + allUsesOfAllSymbols |> shouldEqual [("N", [("file2", ((1, 7), (1, 8)))]); ("val y2", [("file2", ((12, 4), (12, 6)))]); ("val pair2", [("file2", ((23, 10), (23, 15)))]); @@ -399,19 +400,16 @@ let ``Test project1 all uses of all signature symbols`` () = ("val fff", [("file1", ((7, 4), (7, 7))); ("file2", ((9, 28), (9, 33)))]); ("C", [("file1", ((3, 5), (3, 6))); ("file1", ((9, 15), (9, 16))); - ("file2", ((38, 12), (38, 15))); ("file2", ((38, 22), (38, 25)))]); + ("file2", ((38, 12), (38, 15))); ("file2", ((38, 22), (38, 25))); ("file2", ((38, 22), (38, 25)))]); ("member .ctor", [("file1", ((3, 5), (3, 6))); ("file1", ((9, 15), (9, 16))); - ("file2", ((38, 12), (38, 15))); ("file2", ((38, 22), (38, 25)))]); + ("file2", ((38, 12), (38, 15))); ("file2", ((38, 22), (38, 25))); ("file2", ((38, 22), (38, 25)))]); ("member get_P", [("file1", ((4, 13), (4, 14)))]); ("property P", [("file1", ((4, 13), (4, 14)))]); ("CAbbrev", [("file1", ((9, 5), (9, 12))); ("file2", ((39, 12), (39, 21))); - ("file2", ((39, 28), (39, 37)))]); + ("file2", ((39, 28), (39, 37))); ("file2", ((39, 28), (39, 37)))]); ("property P", [("file1", ((4, 13), (4, 14)))])] - set allUsesOfAllSymbols - set expected |> shouldEqual Set.empty - set expected - set allUsesOfAllSymbols |> shouldEqual Set.empty - (set expected = set allUsesOfAllSymbols) |> shouldEqual true [] let ``Test project1 all uses of all symbols`` () = @@ -724,36 +722,32 @@ let ``Test project2 all uses of all signature symbols`` () = [ for s in allSymbols do let uses = [ for s in wholeProjectResults.GetUsesOfSymbol(s) -> (if s.FileName = Project2.fileName1 then "file1" else "??"), tupsZ s.Range ] yield s.ToString(), uses ] - let expected = - [("M", [("file1", ((1, 7), (1, 8)))]); - ("val c", [("file1", ((19, 4), (19, 5))); ("file1", ((20, 8), (20, 9)))]); - ("val GenericFunction", - [("file1", ((22, 4), (22, 19))); ("file1", ((24, 8), (24, 23)))]); - ("generic parameter T", - [("file1", ((22, 23), (22, 25))); ("file1", ((22, 30), (22, 32))); - ("file1", ((22, 45), (22, 47))); ("file1", ((22, 50), (22, 52)))]); - ("DUWithNormalFields", [("file1", ((3, 5), (3, 23)))]); - ("DU1", [("file1", ((4, 6), (4, 9))); ("file1", ((8, 8), (8, 11)))]); - ("field Item1", []); ("field Item2", []); - ("DU2", [("file1", ((5, 6), (5, 9))); ("file1", ((9, 8), (9, 11)))]); - ("D", [("file1", ((6, 6), (6, 7))); ("file1", ((10, 8), (10, 9)))]); - ("DUWithNamedFields", [("file1", ((12, 5), (12, 22)))]); - ("DU", [("file1", ((12, 25), (12, 27))); ("file1", ((14, 8), (14, 10)))]); - ("field x", [("file1", ((12, 31), (12, 32))); ("file1", ((14, 11), (14, 12)))]); - ("field y", [("file1", ((12, 41), (12, 42))); ("file1", ((14, 16), (14, 17)))]); - ("GenericClass`1", - [("file1", ((16, 5), (16, 17))); ("file1", ((19, 8), (19, 20)))]); - ("generic parameter T", - [("file1", ((16, 18), (16, 20))); ("file1", ((17, 34), (17, 36)))]); - ("member .ctor", - [("file1", ((16, 5), (16, 17))); ("file1", ((19, 8), (19, 20)))]); - ("member GenericMethod", - [("file1", ((17, 13), (17, 26))); ("file1", ((20, 8), (20, 23)))]); - ("generic parameter U", - [("file1", ((17, 27), (17, 29))); ("file1", ((17, 41), (17, 43)))])] - set allUsesOfAllSymbols - set expected |> shouldEqual Set.empty - set expected - set allUsesOfAllSymbols |> shouldEqual Set.empty - (set expected = set allUsesOfAllSymbols) |> shouldEqual true + allUsesOfAllSymbols |> shouldEqual + [("M", [("file1", ((1, 7), (1, 8)))]); + ("val c", [("file1", ((19, 4), (19, 5))); ("file1", ((20, 8), (20, 9)))]); + ("val GenericFunction", [("file1", ((22, 4), (22, 19))); ("file1", ((24, 8), (24, 23)))]); + ("generic parameter T", [ + ("file1", ((22, 23), (22, 25))) + ("file1", ((22, 30), (22, 32))) + ("file1", ((22, 45), (22, 47))) + ("file1", ((22, 50), (22, 52))) + ]); + ("DUWithNormalFields", [("file1", ((3, 5), (3, 23)))]); + ("DU1", [("file1", ((4, 6), (4, 9))); ("file1", ((8, 8), (8, 11)))]); + ("field Item1", []); ("field Item2", []); + ("DU2", [("file1", ((5, 6), (5, 9))); ("file1", ((9, 8), (9, 11)))]); + ("field Item1", []); ("field Item2", []); + ("D", [("file1", ((6, 6), (6, 7))); ("file1", ((10, 8), (10, 9)))]) + ("field Item1", []); ("field Item2", []); + ("DUWithNamedFields", [("file1", ((12, 5), (12, 22)))]); + ("DU", [("file1", ((12, 25), (12, 27))); ("file1", ((14, 8), (14, 10)))]); + ("field x", [("file1", ((12, 31), (12, 32))); ("file1", ((14, 11), (14, 12)))]); + ("field y", [("file1", ((12, 41), (12, 42))); ("file1", ((14, 16), (14, 17)))]); + ("GenericClass`1", [("file1", ((16, 5), (16, 17))); ("file1", ((19, 8), (19, 20)))]); + ("generic parameter T", [("file1", ((16, 18), (16, 20))); ("file1", ((17, 34), (17, 36)))]); + ("member .ctor", [("file1", ((16, 5), (16, 17))); ("file1", ((19, 8), (19, 20)))]); + ("member GenericMethod", [("file1", ((17, 13), (17, 26))); ("file1", ((20, 8), (20, 23)))]); + ("generic parameter U", [("file1", ((17, 27), (17, 29))); ("file1", ((17, 41), (17, 43)))])] [] let ``Test project2 all uses of all symbols`` () = @@ -762,7 +756,7 @@ let ``Test project2 all uses of all symbols`` () = let allUsesOfAllSymbols = [ for s in wholeProjectResults.GetAllUsesOfAllSymbols() -> s.Symbol.DisplayName, (if s.FileName = Project2.fileName1 then "file1" else "???"), tupsZ s.Range, attribsOfSymbol s.Symbol ] - let expected = + allUsesOfAllSymbols |> shouldEqual [("int", "file1", ((4, 13), (4, 16)), ["abbrev"]); ("int", "file1", ((4, 19), (4, 22)), ["abbrev"]); ("int", "file1", ((5, 13), (5, 16)), ["abbrev"]); @@ -784,10 +778,10 @@ let ``Test project2 all uses of all symbols`` () = ("D", "file1", ((10, 8), (10, 9)), []); ("int", "file1", ((12, 35), (12, 38)), ["abbrev"]); ("int", "file1", ((12, 45), (12, 48)), ["abbrev"]); - ("int", "file1", ((12, 35), (12, 38)), ["abbrev"]); ("x", "file1", ((12, 31), (12, 32)), ["field"]); - ("int", "file1", ((12, 45), (12, 48)), ["abbrev"]); + ("int", "file1", ((12, 35), (12, 38)), ["abbrev"]); ("y", "file1", ((12, 41), (12, 42)), ["field"]); + ("int", "file1", ((12, 45), (12, 48)), ["abbrev"]); ("DU", "file1", ((12, 25), (12, 27)), []); ("DUWithNamedFields", "file1", ((12, 5), (12, 22)), ["union"]); ("DU", "file1", ((14, 8), (14, 10)), []); @@ -806,11 +800,11 @@ let ``Test project2 all uses of all symbols`` () = ("u", "file1", ((17, 38), (17, 39)), []); ("t", "file1", ((17, 31), (17, 32)), []); ("GenericClass", "file1", ((19, 8), (19, 20)), ["member"; "ctor"]); - ("int", "file1", ((19, 21), (19, 24)), ["abbrev"]); + ("int", "file1", ((19, 21), (19, 24)), ["abbrev"]) ("c", "file1", ((19, 4), (19, 5)), ["val"]); ("c", "file1", ((20, 8), (20, 9)), ["val"]); - ("GenericMethod", "file1", ((20, 8), (20, 23)), ["member"]); ("int", "file1", ((20, 24), (20, 27)), ["abbrev"]); + ("GenericMethod", "file1", ((20, 8), (20, 23)), ["member"]); ("T", "file1", ((22, 23), (22, 25)), []); ("T", "file1", ((22, 30), (22, 32)), []); ("y", "file1", ((22, 27), (22, 28)), []); @@ -822,9 +816,6 @@ let ``Test project2 all uses of all symbols`` () = ("GenericFunction", "file1", ((22, 4), (22, 19)), ["val"]); ("GenericFunction", "file1", ((24, 8), (24, 23)), ["val"]); ("M", "file1", ((1, 7), (1, 8)), ["module"])] - set allUsesOfAllSymbols - set expected |> shouldEqual Set.empty - set expected - set allUsesOfAllSymbols |> shouldEqual Set.empty - (set expected = set allUsesOfAllSymbols) |> shouldEqual true //----------------------------------------------------------------------------------------- @@ -2055,24 +2046,22 @@ let ``Test Project11 all symbols`` () = [|("System", "System", "file1", ((4, 15), (4, 21)), [], ["namespace"]); ("Collections", "Collections", "file1", ((4, 22), (4, 33)), [], ["namespace"]); ("Generic", "Generic", "file1", ((4, 34), (4, 41)), [], ["namespace"]); - ("Dictionary`2", "Dictionary", "file1", ((4, 15), (4, 52)), ["type"], - ["class"]); ("int", "int", "file1", ((4, 53), (4, 56)), [], ["abbrev"]); - ("int", "int", "file1", ((4, 57), (4, 60)), [], ["abbrev"]); - ("Enumerator", "Enumerator", "file1", ((4, 62), (4, 72)), ["type"], - ["valuetype"]); + ("Dictionary`2", "Dictionary", "file1", ((4, 15), (4, 52)), ["type"], ["class"]) + ("int", "int", "file1", ((4, 53), (4, 56)), ["type"], ["abbrev"]); + ("int", "int", "file1", ((4, 57), (4, 60)), ["type"], ["abbrev"]); + ("Enumerator", "Enumerator", "file1", ((4, 62), (4, 72)), ["type"], ["valuetype"]); ("member .ctor", "Enumerator", "file1", ((4, 15), (4, 72)), [], ["member"]); ("val enum", "enum", "file1", ((4, 4), (4, 8)), ["defn"], ["val"]); ("System", "System", "file1", ((5, 11), (5, 17)), [], ["namespace"]); ("Collections", "Collections", "file1", ((5, 18), (5, 29)), [], ["namespace"]); ("Generic", "Generic", "file1", ((5, 30), (5, 37)), [], ["namespace"]); - ("Dictionary`2", "Dictionary", "file1", ((5, 11), (5, 48)), ["type"], - ["class"]); ("int", "int", "file1", ((5, 49), (5, 52)), ["type"], ["abbrev"]); + ("Dictionary`2", "Dictionary", "file1", ((5, 11), (5, 48)), ["type"], ["class"]) + ("int", "int", "file1", ((5, 49), (5, 52)), ["type"], ["abbrev"]); ("int", "int", "file1", ((5, 53), (5, 56)), ["type"], ["abbrev"]); - ("Enumerator", "Enumerator", "file1", ((5, 58), (5, 68)), ["type"], - ["valuetype"]); ("val x", "x", "file1", ((5, 9), (5, 10)), ["defn"], []); + ("Enumerator", "Enumerator", "file1", ((5, 58), (5, 68)), ["type"], ["valuetype"]) + ("val x", "x", "file1", ((5, 9), (5, 10)), ["defn"], []); ("val fff", "fff", "file1", ((5, 4), (5, 7)), ["defn"], ["val"]); - ("NestedTypes", "NestedTypes", "file1", ((2, 7), (2, 18)), ["defn"], - ["module"])|] + ("NestedTypes", "NestedTypes", "file1", ((2, 7), (2, 18)), ["defn"], ["module"])|] //----------------------------------------------------------------------------------------- // see https://github.com/fsharp/FSharp.Compiler.Service/issues/92 @@ -2189,15 +2178,15 @@ let ``Test Project13 all symbols`` () = allUsesOfAllSymbols |> shouldEqual [|("System", "System", "file1", ((4, 14), (4, 20)), [], ["namespace"]); - ("Object", "Object", "file1", ((4, 14), (4, 27)), [], ["class"]); + ("Object", "Object", "file1", ((4, 14), (4, 27)), ["type"], ["class"]); ("member .ctor", "Object", "file1", ((4, 14), (4, 27)), [], ["member"]); ("val x1", "x1", "file1", ((4, 4), (4, 6)), ["defn"], ["val"]); ("System", "System", "file1", ((5, 14), (5, 20)), [], ["namespace"]); - ("DateTime", "DateTime", "file1", ((5, 14), (5, 29)), [], ["valuetype"]); + ("DateTime", "DateTime", "file1", ((5, 14), (5, 29)), ["type"], ["valuetype"]); ("member .ctor", "DateTime", "file1", ((5, 14), (5, 29)), [], ["member"]); ("val x2", "x2", "file1", ((5, 4), (5, 6)), ["defn"], ["val"]); ("System", "System", "file1", ((6, 13), (6, 19)), [], ["namespace"]); - ("DateTime", "DateTime", "file1", ((6, 13), (6, 28)), [], ["valuetype"]); + ("DateTime", "DateTime", "file1", ((6, 13), (6, 28)), ["type"], ["valuetype"]); ("member .ctor", "DateTime", "file1", ((6, 13), (6, 28)), [], ["member"]); ("val x3", "x3", "file1", ((6, 4), (6, 6)), ["defn"], ["val"]); ("ExternalTypes", "ExternalTypes", "file1", ((2, 7), (2, 20)), ["defn"], @@ -2777,7 +2766,6 @@ let ``Test Project17 all symbols`` () = ("FSharp", "FSharp", "file1", ((4, 18), (4, 24)), [], ["namespace"]); ("FSharpList`1", "List", "file1", ((4, 8), (4, 41)), [], ["union"]); ("int", "int", "file1", ((4, 42), (4, 45)), ["type"], ["abbrev"]); - ("FSharpList`1", "List", "file1", ((4, 8), (4, 46)), [], ["union"]); ("property Empty", "Empty", "file1", ((4, 8), (4, 52)), [], ["member"; "prop"]); ("System", "System", "file1", ((6, 11), (6, 17)), [], ["namespace"]); ("Collections", "Collections", "file1", ((6, 18), (6, 29)), [], ["namespace"]); @@ -2786,14 +2774,11 @@ let ``Test Project17 all symbols`` () = ("generic parameter T", "T", "file1", ((6, 44), (6, 46)), ["type"], []); ("val x", "x", "file1", ((6, 8), (6, 9)), ["defn"], []); ("val x", "x", "file1", ((6, 51), (6, 52)), [], []); - ("property Item", "Item", "file1", ((6, 51), (6, 57)), [], - ["slot"; "member"; "prop"]); + ("property Item", "Item", "file1", ((6, 51), (6, 57)), [], ["slot"; "member"; "prop"]); ("val x", "x", "file1", ((6, 62), (6, 63)), [], []); - ("property Item", "Item", "file1", ((6, 62), (6, 67)), [], - ["slot"; "member"; "prop"]); + ("property Item", "Item", "file1", ((6, 62), (6, 67)), [], ["slot"; "member"; "prop"]); ("val x", "x", "file1", ((6, 69), (6, 70)), [], []); - ("property Count", "Count", "file1", ((6, 69), (6, 76)), [], - ["slot"; "member"; "prop"]); + ("property Count", "Count", "file1", ((6, 69), (6, 76)), [], ["slot"; "member"; "prop"]); ("val f1", "f1", "file1", ((6, 4), (6, 6)), ["defn"], ["val"]); ("System", "System", "file1", ((8, 11), (8, 17)), [], ["namespace"]); ("Collections", "Collections", "file1", ((8, 18), (8, 29)), [], ["namespace"]); @@ -2802,15 +2787,13 @@ let ``Test Project17 all symbols`` () = ("int", "int", "file1", ((8, 44), (8, 47)), ["type"], ["abbrev"]); ("val x", "x", "file1", ((8, 8), (8, 9)), ["defn"], []); ("val x", "x", "file1", ((8, 52), (8, 53)), [], []); - ("property Item", "Item", "file1", ((8, 52), (8, 57)), [], - ["slot"; "member"; "prop"]); + ("property Item", "Item", "file1", ((8, 52), (8, 57)), [], ["slot"; "member"; "prop"]); ("val f2", "f2", "file1", ((8, 4), (8, 6)), ["defn"], ["val"]); ("System", "System", "file1", ((10, 11), (10, 17)), [], ["namespace"]); ("Exception", "Exception", "file1", ((10, 11), (10, 27)), ["type"], ["class"]); ("val x", "x", "file1", ((10, 8), (10, 9)), ["defn"], []); ("val x", "x", "file1", ((10, 31), (10, 32)), [], []); - ("property HelpLink", "HelpLink", "file1", ((10, 31), (10, 41)), [], - ["slot"; "member"; "prop"]); + ("property HelpLink", "HelpLink", "file1", ((10, 31), (10, 41)), [], ["slot"; "member"; "prop"]); ("val f3", "f3", "file1", ((10, 4), (10, 6)), ["defn"], ["val"]); ("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], ["module"])|] @@ -2859,7 +2842,6 @@ let ``Test Project18 all symbols`` () = allUsesOfAllSymbols |> shouldEqual [|("list`1", "list", "file1", ((4, 8), (4, 12)), [], false); - ("list`1", "list", "file1", ((4, 8), (4, 15)), [], false); ("property Empty", "Empty", "file1", ((4, 8), (4, 21)), [], false); ("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], false)|] @@ -3724,12 +3706,12 @@ let ``Test Project25 symbol uses of type-provided members`` () = ("Microsoft.FSharp.Data", "file1", ((3, 12), (3, 16)), ["namespace"]); ("FSharp.Data.XmlProvider", "file1", ((4, 15), (4, 26)), ["class"; "provided"; "erased"]); + ("FSharp.Data.XmlProvider<...>", "file1", ((4, 15), (4, 26)), + ["class"; "provided"; "staticinst"; "erased"]); ("FSharp.Data.XmlProvider", "file1", ((4, 15), (4, 26)), ["class"; "provided"; "erased"]); - ("FSharp.Data.XmlProvider", "file1", ((4, 15), (4, 26)), - ["class"; "provided"; "erased"]); - ("FSharp.Data.XmlProvider", "file1", ((4, 15), (4, 26)), - ["class"; "provided"; "erased"]); + ("FSharp.Data.XmlProvider<...>", "file1", ((4, 15), (4, 26)), + ["class"; "provided"; "staticinst"; "erased"]); ("TypeProviderTests.Project", "file1", ((4, 5), (4, 12)), ["abbrev"]); ("TypeProviderTests.Project", "file1", ((5, 8), (5, 15)), ["abbrev"]); ("FSharp.Data.XmlProvider<...>.GetSample", "file1", ((5, 8), (5, 25)), @@ -3741,9 +3723,7 @@ let ``Test Project25 symbol uses of type-provided members`` () = ("TypeProviderTests.Record", "file1", ((8, 10), (8, 16)), ["record"]); ("TypeProviderTests.Record.Field", "file1", ((8, 17), (8, 22)), ["field"]); ("TypeProviderTests.r", "file1", ((8, 4), (8, 5)), ["val"]); - ("FSharp.Data.XmlProvider", "file1", ((10, 8), (10, 19)), - ["class"; "provided"; "erased"]); - ("FSharp.Data.XmlProvider<...>", "file1", ((10, 8), (10, 68)), + ("FSharp.Data.XmlProvider<...>", "file1", ((10, 8), (10, 19)), ["class"; "provided"; "staticinst"; "erased"]); ("FSharp.Data.XmlProvider<...>.GetSample", "file1", ((10, 8), (10, 78)), ["member"]); ("TypeProviderTests", "file1", ((2, 7), (2, 24)), ["module"])|] diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 6dbfd2bbaf9..041a461a12f 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -7,7 +7,7 @@ module Tests.Service.Symbols #endif -open System +open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Service.Tests.Common open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax @@ -751,3 +751,98 @@ type Foo() = and set (a: int) (b: float) = () """ (5, 14, " member _.X", "X") + + +module TypeSymbols = + let getSymbols f (symbolUses: FSharpSymbolUse list) = + symbolUses + |> List.choose (fun symbolUse -> match symbolUse.Symbol with :? FSharpEntity as e when f e -> Some(e, symbolUse) | _ -> None) + |> List.map (fun (e, symbolUse) -> e.DisplayNameCore, symbolUse.GenericArguments |> List.map (fun (_, t) -> t.Format(symbolUse.DisplayContext))) + + let isInterface (entity: FSharpEntity) = + entity.IsInterface + + let isClass (entity: FSharpEntity) = + entity.IsClass + + [] + let ``Interface 01`` () = + let _, checkResults = getParseAndCheckResults """ +module Module + +open System + +IDisposable +""" + let symbolUses: FSharpSymbolUse list = getSymbolUses checkResults + symbolUses + |> getSymbols isInterface + |> shouldEqual [ + "IDisposable", [] + ] + + [] + let ``Interface 02`` () = + let _, checkResults = getParseAndCheckResults """ +module Module + +System.IDisposable +""" + let symbolUses = getSymbolUses checkResults + symbolUses + |> getSymbols isInterface + |> shouldEqual [ + "IDisposable", [] + ] + + [] + let ``Interface 03 - Application`` () = + let _, checkResults = getParseAndCheckResults """ +module Module + +open System.Collections.Generic + +IList +IList +IList<_> +""" + let symbolUses = getSymbolUses checkResults + symbolUses + |> getSymbols isInterface + |> shouldEqual [ + "IList", ["int"] + "IList", ["'a"] + "IList", ["'a"] + ] + + [] + let ``Interface 04 - Application`` () = + let _, checkResults = getParseAndCheckResults """ +module Module + +open System.Collections.Generic + +let l: IList<_> = [|1|] +""" + let symbolUses = getSymbolUses checkResults + symbolUses + |> getSymbols isInterface + |> shouldEqual [ + "IList", ["int"] + ] + + [] + let ``Class 01 - Application`` () = + let _, checkResults = getParseAndCheckResults """ +module Module + +open System.Collections.Generic + +let l: List<_> = List [|1|] +""" + let symbolUses = getSymbolUses checkResults + symbolUses + |> getSymbols isClass + |> shouldEqual [ + "List", ["int"] + ] \ No newline at end of file