From 9fd06108987aaddd5e25a40baea1495693e54048 Mon Sep 17 00:00:00 2001 From: dungpa Date: Mon, 7 Sep 2015 01:07:28 +0200 Subject: [PATCH] Add warnings for extra arguments of failwithf function --- src/fsharp/CheckFormatStrings.fs | 20 +++++++++++++----- src/fsharp/CheckFormatStrings.fsi | 2 ++ src/fsharp/FSComp.txt | 2 +- src/fsharp/PostInferenceChecks.fs | 34 +++++++++++++++++++++---------- src/fsharp/TcGlobals.fs | 16 ++++++++++----- 5 files changed, 52 insertions(+), 22 deletions(-) diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index b5bc537745c..e9b6ce653b8 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -48,7 +48,7 @@ let newInfo ()= addZeros = false; precision = false} -let ParseFormatString m g fmt bty cty dty = +let parseFormatStringInternal m g fmt bty cty = let len = String.length fmt let rec parseLoop acc i = @@ -58,10 +58,7 @@ let ParseFormatString m g fmt bty cty dty = acc |> List.map snd |> List.rev else failwithf "%s" <| FSComp.SR.forPositionalSpecifiersNotPermitted() - - let aty = List.foldBack (-->) argtys dty - let ety = mkTupledTy g argtys - aty,ety + argtys elif System.Char.IsSurrogatePair(fmt,i) then parseLoop acc (i+2) else @@ -230,3 +227,16 @@ let ParseFormatString m g fmt bty cty dty = | _ -> parseLoop acc (i+1) parseLoop [] 0 +let ParseFormatString m g fmt bty cty dty = + let argtys = parseFormatStringInternal m g fmt bty cty + let aty = List.foldBack (-->) argtys dty + let ety = mkTupledTy g argtys + aty, ety + +let TryCountFormatStringArguments m g fmt bty cty = + try + parseFormatStringInternal m g fmt bty cty + |> List.length + |> Some + with _ -> + None \ No newline at end of file diff --git a/src/fsharp/CheckFormatStrings.fsi b/src/fsharp/CheckFormatStrings.fsi index 0773039671a..5dbe56e3321 100644 --- a/src/fsharp/CheckFormatStrings.fsi +++ b/src/fsharp/CheckFormatStrings.fsi @@ -14,3 +14,5 @@ open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.Internal val ParseFormatString : Range.range -> TcGlobals -> string -> TType -> TType -> TType -> TType * TType + +val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index eb88442ff77..03a39be5b3d 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1343,4 +1343,4 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS 3186,pickleMissingDefinition,"An error occurred while reading the F# metadata node at position %d in table '%s' of assembly '%s'. The node had no matching declaration. Please report this warning. You may need to recompile the F# assembly you are using." 3187,checkNotSufficientlyGenericBecauseOfScope,"Type inference caused the type variable %s to escape its scope. Consider adding an explicit type parameter declaration or adjusting your code to be less generic." 3188,checkNotSufficientlyGenericBecauseOfScopeAnon,"Type inference caused an inference type variable to escape its scope. Consider adding type annotations to make your code less generic." -3189,checkRaiseFamilyFunctionArgumentCount,"Function '%s' applies to at most %d argument(s). Remaining arguments are being ignored." +3189,checkRaiseFamilyFunctionArgumentCount,"Redundant arguments are being ignored in function '%s'. Expected %d but got %d arguments." diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 3a8c8d2c95e..855d5ca35fe 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -584,22 +584,34 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = | Expr.App(f,fty,tyargs,argsl,m) -> let (|OptionalCoerce|) = function - | Expr.Op(TOp.Coerce _,_,[Expr.App(f, _, _, [], _)],_) -> f + | Expr.Op(TOp.Coerce _, _, [Expr.App(f, _, _, [], _)], _) -> f | x -> x if cenv.reportErrors then let g = cenv.g match f with - | OptionalCoerce(Expr.Val(v, _, m')) + | OptionalCoerce(Expr.Val(v, _, funcRange)) when (valRefEq g v g.raise_vref || valRefEq g v g.failwith_vref || valRefEq g v g.null_arg_vref || valRefEq g v g.invalid_op_vref) -> - match argsl with - | [] | [_] -> () - | _ :: _ :: _ -> - warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 1), m')) - | OptionalCoerce(Expr.Val(v, _, m')) when valRefEq g v g.invalid_arg_vref -> - match argsl with - | [] | [_] | [_; _] -> () - | _ :: _ :: _ :: _ -> - warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 2), m')) + match argsl with + | [] | [_] -> () + | _ :: _ :: _ -> + warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 1, List.length argsl), funcRange)) + | OptionalCoerce(Expr.Val(v, _, funcRange)) when valRefEq g v g.invalid_arg_vref -> + match argsl with + | [] | [_] | [_; _] -> () + | _ :: _ :: _ :: _ -> + warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 2, List.length argsl), funcRange)) + | OptionalCoerce(Expr.Val(failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref -> + match argsl with + | Expr.App (Expr.Val(newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const(Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref -> + match CheckFormatStrings.TryCountFormatStringArguments formatRange g formatString typB typC with + | Some n -> + let expected = n + 1 + let actual = List.length xs + 1 + if expected < actual then + warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(failwithfFunc.DisplayName, expected, actual), funcRange)) + | None -> () + | _ -> + () | _ -> () diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 547fa465e40..2801007ee76 100644 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -522,6 +522,9 @@ type public TcGlobals = null_arg_vref : ValRef invalid_op_info : IntrinsicValRef invalid_op_vref : ValRef + failwithf_info : IntrinsicValRef + failwithf_vref : ValRef + lazy_force_info : IntrinsicValRef lazy_create_info : IntrinsicValRef @@ -920,11 +923,12 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let unchecked_unary_minus_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_UnaryNegation" ,None ,None ,[vara], mk_unop_ty varaTy) let unchecked_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "not" ,None ,Some "Not" ,[], mk_unop_ty bool_ty) - let raise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "raise" ,None ,Some "Raise" ,[vara],([[mkSysNonGenericTy sys "Exception"]],varaTy)) - let failwith_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "failwith" ,None ,Some "FailWith",[vara],([[string_ty]],varaTy)) - let invalid_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidArg" ,None ,Some "InvalidArg",[vara],([[string_ty]; [string_ty]],varaTy)) - let null_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nullArg" ,None ,Some "NullArg",[vara],([[string_ty]],varaTy)) - let invalid_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidOp" ,None ,Some "InvalidOp",[vara],([[string_ty]],varaTy)) + let raise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "raise" ,None ,Some "Raise" ,[vara], ([[mkSysNonGenericTy sys "Exception"]],varaTy)) + let failwith_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "failwith" ,None ,Some "FailWith" ,[vara], ([[string_ty]],varaTy)) + let invalid_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidArg" ,None ,Some "InvalidArg" ,[vara], ([[string_ty]; [string_ty]],varaTy)) + let null_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nullArg" ,None ,Some "NullArg" ,[vara], ([[string_ty]],varaTy)) + let invalid_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidOp" ,None ,Some "InvalidOp" ,[vara], ([[string_ty]],varaTy)) + let failwithf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "failwithf" ,None, Some "PrintFormatToStringThenFail" ,[vara;varb],([[mk_format4_ty varaTy unit_ty string_ty string_ty]], varaTy)) let reraise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "reraise" ,None ,Some "Reraise",[vara], ([[unit_ty]],varaTy)) let typeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typeof" ,None ,Some "TypeOf" ,[vara], ([],system_Type_typ)) @@ -1375,6 +1379,8 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa null_arg_vref = ValRefForIntrinsic null_arg_info invalid_op_info = invalid_op_info invalid_op_vref = ValRefForIntrinsic invalid_op_info + failwithf_info = failwithf_info + failwithf_vref = ValRefForIntrinsic failwithf_info reraise_info = reraise_info reraise_vref = ValRefForIntrinsic reraise_info