diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index f2e99ce312b..0d8ea5a3fa5 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -118,7 +118,7 @@ let GetRangeOfError(err:PhasedError) = | IndentationProblem(_,m) | ErrorFromAddingTypeEquation(_,_,_,_,_,_,m) | ErrorFromApplyingDefault(_,_,_,_,_,m) - | ErrorsFromAddingSubsumptionConstraint(_,_,_,_,_,m) + | ErrorsFromAddingSubsumptionConstraint(_,_,_,_,_,_,m) | FunctionExpected(_,_,m) | BakedInMemberConstraintName(_,m) | StandardOperatorRedefinitionWarning(_,m) @@ -369,6 +369,7 @@ let GetErrorNumber(err:PhasedError) = #if EXTENSIONTYPING | :? TypeProviderError as e -> e.Number #endif + | ErrorsFromAddingSubsumptionConstraint (_,_,_,_,_,ContextInfo.DowncastUsedInsteadOfUpcast _,_) -> fst (FSComp.SR.considerUpcast("","")) | _ -> 193 GetFromException err.Exception @@ -413,9 +414,9 @@ let SplitRelatedErrors(err:PhasedError) = | ErrorFromApplyingDefault(g,denv,tp,defaultType,e,m) -> let e,related = SplitRelatedException e ErrorFromApplyingDefault(g,denv,tp,defaultType,e.Exception,m)|>ToPhased, related - | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,m) -> + | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,m) -> let e,related = SplitRelatedException e - ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,m)|>ToPhased, related + ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,contextInfo,m)|>ToPhased, related | ErrorFromAddingConstraint(x,e,m) -> let e,related = SplitRelatedException e ErrorFromAddingConstraint(x,e.Exception,m)|>ToPhased, related @@ -662,13 +663,23 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = os.Append(ErrorFromApplyingDefault1E().Format defaultType) |> ignore OutputExceptionR os e os.Append(ErrorFromApplyingDefault2E().Format) |> ignore - | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,_) -> - if not (typeEquiv g t1 t2) then ( - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 - if t1 <> (t2 + tpcs) then - os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore - ) - OutputExceptionR os e + | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,_) -> + match contextInfo with + | ContextInfo.DowncastUsedInsteadOfUpcast isOperator -> + let t1,t2,_ = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + if isOperator then + os.Append(FSComp.SR.considerUpcastOperator(t1,t2) |> snd) |> ignore + else + os.Append(FSComp.SR.considerUpcast(t1,t2) |> snd) |> ignore + | _ -> + if not (typeEquiv g t1 t2) then + let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + if t1 <> (t2 + tpcs) then + os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore + else + OutputExceptionR os e + else + OutputExceptionR os e | UpperCaseIdentifierInPattern(_) -> os.Append(UpperCaseIdentifierInPatternE().Format) |> ignore | NotUpperCaseConstructor(_) -> diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 1877b4cfa75..728ed9de68e 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -128,6 +128,10 @@ type ContextInfo = | RecordFields /// The type equation comes from the verification of a tuple in record fields. | TupleInRecordFields +/// The type equation comes from a runtime type test. +| RuntimeTypeTest of bool +/// The type equation comes from an downcast where a upcast could be used. +| DowncastUsedInsteadOfUpcast of bool exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range * range exception ConstraintSolverInfiniteTypes of DisplayEnv * TType * TType * range * range @@ -139,7 +143,7 @@ exception ConstraintSolverRelatedInformation of string option * range * exn exception ErrorFromApplyingDefault of TcGlobals * DisplayEnv * Tast.Typar * TType * exn * range exception ErrorFromAddingTypeEquation of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range -exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * range +exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range exception ErrorFromAddingConstraint of DisplayEnv * exn * range exception PossibleOverload of DisplayEnv * string * exn * range exception UnresolvedOverloading of DisplayEnv * exn list * string * range @@ -1922,9 +1926,16 @@ and private DefinitelyEquiv (csenv:ConstraintSolverEnv) isConstraint calledArg ( // Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure // to allow us to report the outer types involved in the constraint -and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 = +and private SolveTypSubsumesTypWithReport contextInfo (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 = TryD (fun () -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m trace ty1 ty2) - (fun res -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,m))) + (fun res -> + match contextInfo with + | ContextInfo.RuntimeTypeTest isOperator -> + // test if we can cast other way around + match CollectThenUndo (fun newTrace -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) ty2 ty1) with + | OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.DowncastUsedInsteadOfUpcast isOperator,m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.NoContext,m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,contextInfo,m))) and private SolveTypEqualsTypWithReport contextInfo (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 = TryD (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m trace ty1 ty2) @@ -1941,7 +1952,7 @@ and ArgsMustSubsumeOrConvert let g = csenv.g let m = callerArg.Range let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg - SolveTypSubsumesTypWithReport csenv ndeep m trace calledArgTy callerArg.Type ++ (fun () -> + SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m trace calledArgTy callerArg.Type ++ (fun () -> if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.Type) then @@ -1957,10 +1968,10 @@ and MustUnifyInsideUndo csenv ndeep trace ty1 ty2 = and ArgsMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) = let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg - SolveTypSubsumesTypWithReport csenv ndeep m (WithTrace trace) calledArgTy callerArgTy + SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m (WithTrace trace) calledArgTy callerArgTy and TypesMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace m calledArgTy callerArgTy = - SolveTypSubsumesTypWithReport csenv ndeep m trace calledArgTy callerArgTy + SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m trace calledArgTy callerArgTy and ArgsEquivInsideUndo (csenv:ConstraintSolverEnv) _trace isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) = let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg @@ -2439,10 +2450,8 @@ let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = let csenv = { csenv with MatchingOnly = true } UndoIfFailed (fun trace -> SolveTypSubsumesTypKeepAbbrevs csenv 0 m (WithTrace(trace)) ty1 ty2) - - -let AddCxTypeMustSubsumeType denv css m trace ty1 ty2 = - SolveTypSubsumesTypWithReport (MakeConstraintSolverEnv css m denv) 0 m trace ty1 ty2 +let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = + SolveTypSubsumesTypWithReport contextInfo (MakeConstraintSolverEnv css m denv) 0 m trace ty1 ty2 |> RaiseOperationResult let AddCxMethodConstraint denv css m trace traitInfo = diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index ef4ce86a09c..a0e404983e9 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -60,6 +60,10 @@ type ContextInfo = | RecordFields /// The type equation comes from the verification of a tuple in record fields. | TupleInRecordFields +/// The type equation comes from a runtime type test. +| RuntimeTypeTest of bool +/// The type equation comes from an downcast where a upcast could be used. +| DowncastUsedInsteadOfUpcast of bool exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range * range exception ConstraintSolverInfiniteTypes of DisplayEnv * TType * TType * range * range @@ -70,7 +74,7 @@ exception ConstraintSolverError of string * range * rang exception ConstraintSolverRelatedInformation of string option * range * exn exception ErrorFromApplyingDefault of TcGlobals * DisplayEnv * Typar * TType * exn * range exception ErrorFromAddingTypeEquation of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range -exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * range +exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range exception ErrorFromAddingConstraint of DisplayEnv * exn * range exception UnresolvedConversionOperator of DisplayEnv * TType * TType * range exception PossibleOverload of DisplayEnv * string * exn * range @@ -110,7 +114,7 @@ val AddConstraint : ConstraintSolverEnv -> int -> Ra val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxTypeMustSubsumeType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit +val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool val AddCxMethodConstraint : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 1417a6349fa..6a45de7b7d7 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1294,3 +1294,5 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS 3195,optsResponseFileNameInvalid,"Response file name '%s' is empty, contains invalid characters, has a drive specification without an absolute path, or is too long" 3196,fsharpCoreNotFoundToBeCopied,"Cannot find FSharp.Core.dll in compiler's directory" 3197,etMissingStaticArgumentsToMethod,"This provided method requires static parameters" +3198,considerUpcast,"The conversion from %s to %s is a compile-time safe upcast, not a downcast. Consider using 'upcast' instead of 'downcast'." +3198,considerUpcastOperator,"The conversion from %s to %s is a compile-time safe upcast, not a downcast. Consider using the :> (upcast) operator instead of the :?> (downcast) operator." \ No newline at end of file diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 13a239c3992..ddcffab75a4 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -2820,7 +2820,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = then actualType else let flexibleType = NewInferenceType () - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace actualType flexibleType; + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace actualType flexibleType; flexibleType) // Create a coercion to represent the expansion of the application @@ -2829,7 +2829,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = /// Checks, warnings and constraint assertions for downcasts -let TcRuntimeTypeTest isCast cenv denv m tgty srcTy = +let TcRuntimeTypeTest isCast isOperator cenv denv m tgty srcTy = if TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m tgty srcTy then warning(TypeTestUnnecessary(m)) @@ -2837,12 +2837,13 @@ let TcRuntimeTypeTest isCast cenv denv m tgty srcTy = error(IndeterminateRuntimeCoercion(denv,srcTy,tgty,m)) if isSealedTy cenv.g srcTy then - error(RuntimeCoercionSourceSealed(denv,srcTy,m)) + error(RuntimeCoercionSourceSealed(denv,srcTy,m)) - if isSealedTy cenv.g tgty || - isTyparTy cenv.g tgty || - not (isInterfaceTy cenv.g srcTy) then - AddCxTypeMustSubsumeType denv cenv.css m NoTrace srcTy tgty + if isSealedTy cenv.g tgty || isTyparTy cenv.g tgty || not (isInterfaceTy cenv.g srcTy) then + if isCast then + AddCxTypeMustSubsumeType (ContextInfo.RuntimeTypeTest isOperator) denv cenv.css m NoTrace srcTy tgty + else + AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace srcTy tgty if isErasedType cenv.g tgty then if isCast then @@ -2866,7 +2867,7 @@ let TcStaticUpcast cenv denv m tgty srcTy = if typeEquiv cenv.g srcTy tgty then warning(UpcastUnnecessary(m)) - AddCxTypeMustSubsumeType denv cenv.css m NoTrace tgty srcTy + AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace tgty srcTy @@ -3271,7 +3272,7 @@ let mkSeqCollect cenv env m enumElemTy genTy lam enumExpr = mkCallSeqCollect cenv.g m enumElemTy genResultTy lam enumExpr let mkSeqUsing cenv (env: TcEnv) m resourceTy genTy resourceExpr lam = - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace cenv.g.system_IDisposable_typ resourceTy + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace cenv.g.system_IDisposable_typ resourceTy let genResultTy = NewInferenceType () UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) mkCallSeqUsing cenv.g m resourceTy genResultTy resourceExpr lam @@ -3895,7 +3896,7 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = let tp',tpenv = TcTypar cenv env newOk tpenv tp if (newOk = NoNewTypars) && isSealedTy cenv.g ty' then errorR(Error(FSComp.SR.tcInvalidConstraintTypeSealed(),m)) - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp') + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp') tpenv | WhereTyparSupportsNull(tp,m) -> checkSimpleConstraint tp m AddCxTypeMustSupportNull @@ -4273,7 +4274,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped | SynType.HashConstraint(ty,m) -> let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m let ty',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp) + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp) tp.AsType, tpenv | SynType.StaticConstant (c, m) -> @@ -4793,7 +4794,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat | SynPat.Named (SynPat.IsInst(cty,m),_,_,_,_) -> let srcTy = ty let tgty,tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType env tpenv cty - TcRuntimeTypeTest (*isCast*)false cenv env.DisplayEnv m tgty srcTy + TcRuntimeTypeTest (*isCast*)false (*isOperator*)true cenv env.DisplayEnv m tgty srcTy match pat with | SynPat.IsInst(_,m) -> (fun _ -> TPat_isinst (srcTy,tgty,None,m)),(tpenv,names,takenNames) @@ -5131,7 +5132,7 @@ and TcExprOfUnknownType cenv env tpenv expr = and TcExprFlex cenv flex ty (env: TcEnv) tpenv (e: SynExpr) = if flex then let argty = NewInferenceType () - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css e.Range NoTrace ty argty + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css e.Range NoTrace ty argty let e',tpenv = TcExpr cenv argty env tpenv e let e' = mkCoerceIfNeeded cenv.g ty argty e' e',tpenv @@ -5346,7 +5347,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = let e',srcTy,tpenv = TcExprOfUnknownType cenv env tpenv e UnifyTypes cenv env m overallTy cenv.g.bool_ty let tgty,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty - TcRuntimeTypeTest (*isCast*)false cenv env.DisplayEnv m tgty srcTy + TcRuntimeTypeTest (*isCast*)false (*isOperator*)true cenv env.DisplayEnv m tgty srcTy let e' = mkCallTypeTest cenv.g m tgty e' e', tpenv @@ -5372,15 +5373,15 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = | SynExpr.Downcast(e,_,m) | SynExpr.InferredDowncast (e,m) -> let e',srcTy,tpenv = TcExprOfUnknownType cenv env tpenv e - let tgty,tpenv = + let tgty,tpenv,isOperator = match expr with | SynExpr.Downcast (_,tgty,m) -> let tgty,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty UnifyTypes cenv env m tgty overallTy - tgty,tpenv - | SynExpr.InferredDowncast _ -> overallTy,tpenv + tgty,tpenv,true + | SynExpr.InferredDowncast _ -> overallTy,tpenv,false | _ -> failwith "downcast" - TcRuntimeTypeTest (*isCast*)true cenv env.DisplayEnv m tgty srcTy + TcRuntimeTypeTest (*isCast*)true isOperator cenv env.DisplayEnv m tgty srcTy // TcRuntimeTypeTest ensures tgty is a nominal type. Hence we can insert a check here // based on the nullness semantics of the nominal type. @@ -5505,7 +5506,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = UnifyTypes cenv env m overallTy genCollTy let exprty = NewInferenceType () let genEnumTy = mkSeqTy cenv.g genCollElemTy - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace genEnumTy exprty + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genEnumTy exprty let expr,tpenv = TcExpr cenv exprty env tpenv comp let expr = mkCoerceIfNeeded cenv.g genEnumTy (tyOfExpr cenv.g expr) expr (if isArray then mkCallSeqToArray else mkCallSeqToList) cenv.g m genCollElemTy @@ -7790,7 +7791,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = if not isYield then errorR(Error(FSComp.SR.tcUseYieldBangForMultipleResults(),m)) - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy Some(mkCoerceExpr(resultExpr,genOuterTy,m,genExprTy), tpenv) | SynExpr.YieldOrReturn((isYield,_),yieldExpr,m) -> @@ -8556,7 +8557,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela RecdFieldInstanceChecks cenv.g cenv.amap ad mItem rfinfo let tgty = rfinfo.EnclosingType let valu = isStructTy cenv.g tgty - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css mItem NoTrace tgty objExprTy + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css mItem NoTrace tgty objExprTy let objExpr = if valu then objExpr else mkCoerceExpr(objExpr,tgty,mExprAndItem,objExprTy) let fieldTy = rfinfo.FieldType match delayed with @@ -9929,7 +9930,7 @@ and TcAttribute cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let propNameItem = Item.SetterArg(id, setterItem) CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,propNameItem,propNameItem,ItemOccurence.Use,env.DisplayEnv,ad) - AddCxTypeMustSubsumeType env.DisplayEnv cenv.css m NoTrace argty argtyv + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace argty argtyv AttribNamedArg(nm,argty,isProp,mkAttribExpr expr)) @@ -10072,7 +10073,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope let mkCleanup (tm,tmty) = if isUse then (allValsDefinedByPattern,(tm,tmty)) ||> FlatList.foldBack (fun v (tm,tmty) -> - AddCxTypeMustSubsumeType denv cenv.css v.Range NoTrace cenv.g.system_IDisposable_typ v.Type + AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css v.Range NoTrace cenv.g.system_IDisposable_typ v.Type let cleanupE = BuildDisposableCleanup cenv env m v mkTryFinally cenv.g (tm,cleanupE,m,tmty,SequencePointInBodyOfTry,NoSequencePointAtFinally),tmty) else diff --git a/tests/fsharp/typecheck/sigs/neg04.bsl b/tests/fsharp/typecheck/sigs/neg04.bsl index c24c01939e6..e32b4fb0154 100644 --- a/tests/fsharp/typecheck/sigs/neg04.bsl +++ b/tests/fsharp/typecheck/sigs/neg04.bsl @@ -69,55 +69,55 @@ neg04.fs(121,12,121,16): typecheck error FS0193: Type constraint mismatch. The t 'R' is not compatible with type 'IBar' -The type 'R' is not compatible with the type 'IBar' + neg04.fs(126,12,126,16): typecheck error FS0193: Type constraint mismatch. The type 'U' is not compatible with type 'IBar' -The type 'U' is not compatible with the type 'IBar' + neg04.fs(131,12,131,21): typecheck error FS0193: Type constraint mismatch. The type 'Struct' is not compatible with type 'IBar' -The type 'Struct' is not compatible with the type 'IBar' + neg04.fs(135,10,135,16): typecheck error FS0193: Type constraint mismatch. The type 'R' is not compatible with type 'IBar' -The type 'R' is not compatible with the type 'IBar' + neg04.fs(138,10,138,16): typecheck error FS0193: Type constraint mismatch. The type 'U' is not compatible with type 'IBar' -The type 'U' is not compatible with the type 'IBar' + neg04.fs(141,10,141,21): typecheck error FS0193: Type constraint mismatch. The type 'Struct' is not compatible with type 'IBar' -The type 'Struct' is not compatible with the type 'IBar' + neg04.fs(144,10,144,25): typecheck error FS0193: Type constraint mismatch. The type 'int * int' is not compatible with type 'IBar' -The type 'int * int' is not compatible with the type 'IBar' + neg04.fs(147,10,147,20): typecheck error FS0193: Type constraint mismatch. The type 'int []' is not compatible with type 'IBar' -The type 'int []' is not compatible with the type 'IBar' + neg04.fs(150,10,150,26): typecheck error FS0193: Type constraint mismatch. The type 'int -> int' is not compatible with type 'IBar' -The type 'int -> int' is not compatible with the type 'IBar' + neg04.fs(159,47,159,57): typecheck error FS0692: This function value is being used to construct a delegate type whose signature includes a byref argument. You must use an explicit lambda expression taking 1 arguments. diff --git a/tests/fsharp/typecheck/sigs/neg10.bsl b/tests/fsharp/typecheck/sigs/neg10.bsl index 091d72e1af3..ca631ed99f7 100644 --- a/tests/fsharp/typecheck/sigs/neg10.bsl +++ b/tests/fsharp/typecheck/sigs/neg10.bsl @@ -113,7 +113,7 @@ neg10.fs(239,47,239,48): typecheck error FS0193: Type constraint mismatch. The t ''b' is not compatible with type 'C' -A type parameter is missing a constraint 'when 'b :> C' + neg10.fs(245,50,245,51): typecheck error FS0193: A type parameter is missing a constraint 'when 'b :> C' diff --git a/tests/fsharp/typecheck/sigs/neg20.bsl b/tests/fsharp/typecheck/sigs/neg20.bsl index 21e6f1838d2..8c593a51bf4 100644 --- a/tests/fsharp/typecheck/sigs/neg20.bsl +++ b/tests/fsharp/typecheck/sigs/neg20.bsl @@ -120,7 +120,7 @@ neg20.fs(80,23,80,39): typecheck error FS0193: Type constraint mismatch. The typ 'C list' is not compatible with type 'seq' -The type 'C list' is not compatible with the type 'seq' + neg20.fs(81,34,81,43): typecheck error FS0001: Type mismatch. Expecting a 'A list' @@ -188,12 +188,12 @@ neg20.fs(131,5,131,24): typecheck error FS0041: Possible overload: 'static membe 'obj' is not compatible with type 'int' -The type 'obj' is not compatible with the type 'int'. +. neg20.fs(131,5,131,24): typecheck error FS0041: Possible overload: 'static member C.OM3 : x:'b * y:'b -> int'. Type constraint mismatch. The type 'obj' is not compatible with type ''a' -The type 'obj' is not compatible with the type ''a'. +. neg20.fs(152,13,152,23): typecheck error FS0033: The type 'Test.BadNumberOfGenericParameters.C<_>' expects 1 type argument(s) but is given 2 @@ -228,12 +228,12 @@ neg20.fs(182,14,182,31): typecheck error FS0041: Possible overload: 'static memb 'obj' is not compatible with type 'int' -The type 'obj' is not compatible with the type 'int'. +. neg20.fs(182,14,182,31): typecheck error FS0041: Possible overload: 'static member C2.M : fmt:string * [] args:int [] -> string'. Type constraint mismatch. The type 'obj' is not compatible with type 'int []' -The type 'obj' is not compatible with the type 'int []'. +. neg20.fs(183,14,183,41): typecheck error FS0001: This expression was expected to have type 'unit' @@ -255,12 +255,12 @@ neg20.fs(188,14,188,31): typecheck error FS0041: Possible overload: 'static memb 'obj' is not compatible with type 'string' -The type 'obj' is not compatible with the type 'string'. +. neg20.fs(188,14,188,31): typecheck error FS0041: Possible overload: 'static member C3.M : fmt:string * [] args:string [] -> string'. Type constraint mismatch. The type 'obj' is not compatible with type 'string []' -The type 'obj' is not compatible with the type 'string []'. +. neg20.fs(189,14,189,41): typecheck error FS0001: This expression was expected to have type 'unit' diff --git a/tests/fsharp/typecheck/sigs/neg61.bsl b/tests/fsharp/typecheck/sigs/neg61.bsl index 36020dc8223..826f5af1f86 100644 --- a/tests/fsharp/typecheck/sigs/neg61.bsl +++ b/tests/fsharp/typecheck/sigs/neg61.bsl @@ -88,12 +88,12 @@ neg61.fs(174,22,174,23): typecheck error FS0041: Possible overload: 'member Linq 'int' is not compatible with type 'System.Linq.IQueryable<'a>' -The type 'int' is not compatible with the type 'System.Linq.IQueryable<'a>'. +. neg61.fs(174,22,174,23): typecheck error FS0041: Possible overload: 'member Linq.QueryBuilder.Source : source:System.Collections.Generic.IEnumerable<'T> -> Linq.QuerySource<'T,System.Collections.IEnumerable>'. Type constraint mismatch. The type 'int' is not compatible with type 'System.Collections.Generic.IEnumerable<'a>' -The type 'int' is not compatible with the type 'System.Collections.Generic.IEnumerable<'a>'. +. neg61.fs(180,19,180,31): typecheck error FS3153: Arguments to query operators may require parentheses, e.g. 'where (x > y)' or 'groupBy (x.Length / 10)' diff --git a/tests/fsharp/typecheck/sigs/neg88.bsl b/tests/fsharp/typecheck/sigs/neg88.bsl index eebba317fa2..482acde91c7 100644 --- a/tests/fsharp/typecheck/sigs/neg88.bsl +++ b/tests/fsharp/typecheck/sigs/neg88.bsl @@ -3,16 +3,16 @@ neg88.fs(18,18,18,20): typecheck error FS0001: Type constraint mismatch. The typ ''c -> 'd' is not compatible with type 'Func<'a,'b>' -The type ''c -> 'd' is not compatible with the type 'Func<'a,'b>' + neg88.fs(19,18,19,20): typecheck error FS0001: Type constraint mismatch. The type ''c -> 'd' is not compatible with type 'Expressions.Expression>' -The type ''c -> 'd' is not compatible with the type 'Expressions.Expression>' + neg88.fs(21,10,21,12): typecheck error FS0001: Type constraint mismatch. The type ''b ref' is not compatible with type 'byref<'a>' -The type ''b ref' is not compatible with the type 'byref<'a>' + diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_PrettifyForall.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_PrettifyForall.fs index 23e8cda3832..3832a0f19aa 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_PrettifyForall.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_PrettifyForall.fs @@ -1,5 +1,5 @@ // #Regression #TypeInference -//Type constraint mismatch. The type.+'a.+is not compatible with type.+System\.IDisposable.+The type ''a' is not compatible with the type 'System\.IDisposable' +//Type constraint mismatch. The type.+''a'.+is not compatible with type.+System\.IDisposable // Regression test for F# 3.0 bug 130523 let _ = use x = null diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_TwoDifferentTypeVariablesGen00.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_TwoDifferentTypeVariablesGen00.fs index e3e8a787005..c94cd93f0f5 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_TwoDifferentTypeVariablesGen00.fs +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/TypeInference/E_TwoDifferentTypeVariablesGen00.fs @@ -6,7 +6,7 @@ //This expression was expected to have type. ''a' .but here has type. ''b' //This expression was expected to have type. 'int' .but here has type. ''b' //A type parameter is missing a constraint 'when 'b :> C' -//Type constraint mismatch\. The type . ''b'.+is not compatible with type.+'C'.+A type parameter is missing a constraint 'when 'b :> C' +//Type constraint mismatch. The type.+''b'.+is not compatible with type //No overloads match for method 'M'\. The available overloads are shown below \(or in the Error List window\)\. @@ -19,7 +19,7 @@ //This expression was expected to have type. ''b' .but here has type. ''a' //This expression was expected to have type. 'int' .but here has type. ''b' //A type parameter is missing a constraint 'when 'b :> C' -//Type constraint mismatch\. The type . ''b' .is not compatible with type. 'C' .A type parameter is missing a constraint 'when 'b :> C' +//Type constraint mismatch. The type.+''b'.+is not compatible with type //No overloads match for method 'M'\. The available overloads are shown below \(or in the Error List window\)\. @@ -33,7 +33,7 @@ //This expression was expected to have type. ''a' .but here has type. ''b' //This expression was expected to have type. 'int' .but here has type. ''b' //A type parameter is missing a constraint 'when 'b :> C' -//Type constraint mismatch\. The type . ''b' .is not compatible with type. 'C' .A type parameter is missing a constraint 'when 'b :> C' +//Type constraint mismatch. The type.+''b'.+is not compatible with type //No overloads match for method 'M'\. The available overloads are shown below \(or in the Error List window\)\. @@ -45,7 +45,7 @@ //A type parameter is missing a constraint 'when 'b :> C' -//Type constraint mismatch\. The type . ''b' .is not compatible with type. 'C' .A type parameter is missing a constraint 'when 'b :> C' +//Type constraint mismatch. The type.+''b'.+is not compatible with type // These different return types are used to determine which overload got chosen type One = | One diff --git a/tests/fsharpqa/Source/Warnings/DowncastInsteadOfUpcast.fs b/tests/fsharpqa/Source/Warnings/DowncastInsteadOfUpcast.fs new file mode 100644 index 00000000000..a815425e294 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/DowncastInsteadOfUpcast.fs @@ -0,0 +1,9 @@ +// #Warnings +//Type constraint mismatch. The type + +open System.Collections.Generic + +let orig = Dictionary() :> IDictionary +let c = orig :> Dictionary + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern.fs b/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern.fs new file mode 100644 index 00000000000..67ae796376d --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern.fs @@ -0,0 +1,13 @@ +// #Warnings +//Type constraint mismatch. The type + +open System.Collections.Generic + +let orig = Dictionary() + +let c = + match orig with + | :? IDictionary -> "yes" + | _ -> "no" + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern2.fs b/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern2.fs new file mode 100644 index 00000000000..098969482c5 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/RuntimeTypeTestInPattern2.fs @@ -0,0 +1,13 @@ +// #Warnings +//Type constraint mismatch. The type + +open System.Collections.Generic + +let orig = Dictionary() + +let c = + match orig with + | :? IDictionary as y -> "yes" + y.ToString() + | _ -> "no" + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/UpcastFunctionInsteadOfDowncast.fs b/tests/fsharpqa/Source/Warnings/UpcastFunctionInsteadOfDowncast.fs new file mode 100644 index 00000000000..6bc8c54c124 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/UpcastFunctionInsteadOfDowncast.fs @@ -0,0 +1,9 @@ +// #Warnings +//The conversion from Dictionary to IDictionary is a compile-time safe upcast, not a downcast. Consider using 'upcast' instead of 'downcast'. + +open System.Collections.Generic + +let orig = Dictionary() +let c : IDictionary = downcast orig + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/UpcastInsteadOfDowncast.fs b/tests/fsharpqa/Source/Warnings/UpcastInsteadOfDowncast.fs new file mode 100644 index 00000000000..00962a1521b --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/UpcastInsteadOfDowncast.fs @@ -0,0 +1,9 @@ +// #Warnings +//The conversion from Dictionary to IDictionary is a compile-time safe upcast, not a downcast. + +open System.Collections.Generic + +let orig = Dictionary() +let c = orig :?> IDictionary + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/env.lst b/tests/fsharpqa/Source/Warnings/env.lst index d3f25fc4143..ebb55a244b8 100644 --- a/tests/fsharpqa/Source/Warnings/env.lst +++ b/tests/fsharpqa/Source/Warnings/env.lst @@ -4,3 +4,8 @@ SOURCE=ValidCommaInRecCtor.fs # ValidCommaInRecCtor.fs SOURCE=ElseBranchHasWrongType.fs # ElseBranchHasWrongType.fs SOURCE=AssignmentOnImmutable.fs # AssignmentOnImmutable.fs + SOURCE=UpcastInsteadOfDowncast.fs # UpcastInsteadOfDowncast.fs + SOURCE=UpcastFunctionInsteadOfDowncast.fs # UpcastFunctionInsteadOfDowncast.fs + SOURCE=DowncastInsteadOfUpcast.fs # DowncastInsteadOfUpcast.fs + SOURCE=RuntimeTypeTestInPattern.fs # RuntimeTypeTestInPattern.fs + SOURCE=RuntimeTypeTestInPattern2.fs # RuntimeTypeTestInPattern2.fs diff --git a/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs index 64c3024b2b7..86be53980a5 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs @@ -177,26 +177,17 @@ let g (t : T) = t.Count() """ let expectedMessages = - [ - "Possible overload: 'new : bool -> X'. Type constraint mismatch. The type - 'float' -is not compatible with type - 'bool' -The type 'float' is not compatible with the type 'bool'." - "Possible overload: 'new : int -> X'. Type constraint mismatch. The type - 'float' -is not compatible with type - 'int' -The type 'float' is not compatible with the type 'int'." - ] - |> List.map (fun s -> s.Replace("\r\n", "\n")) + [ "Possible overload: 'new : bool -> X'." + "Possible overload: 'new : int -> X'." ] CheckErrorList content <| fun errors -> Assert.AreEqual(3, List.length errors) assertContains errors "No overloads match for method 'X'. The available overloads are shown below (or in the Error List window)." for expected in expectedMessages do - assertContains errors expected + errors + |> List.exists (fun e -> e.Message.StartsWith expected) + |> Assert.IsTrue [] member public this.``Query.InvalidJoinRelation.GroupJoin``() =