Issue warning for additional unused arguments of 'raise'-family funct…

…ions

closes #630
fixes #46

commit 45c8e02
Author: Anh-Dung Phan <[email protected]>
Date:   Fri Sep 11 21:34:52 2015 +0000

    Add relevant unit tests

commit 91b45f2
Author: Anh-Dung Phan <[email protected]>
Date:   Fri Sep 11 20:51:46 2015 +0000

    Fix compiler warnings exposed by the feature

commit 9fd0610
Author: dungpa <[email protected]>
Date:   Mon Sep 7 01:07:28 2015 +0200

    Add warnings for extra arguments of failwithf function

commit 4794492
Author: dungpa <[email protected]>
Date:   Sun Sep 6 00:25:58 2015 +0200

    Add similar warnings for failwith, invalidArg, nullArg and invalidOp

commit a23e312
Author: dungpa <[email protected]>
Date:   Sat Sep 5 23:49:54 2015 +0200

    Check number of arguments of function 'raise'

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

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

src/fsharp/FSComp.txt

@@ -1343,3 +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,"Redundant arguments are being ignored in function '%s'. Expected %d but got %d arguments."

src/fsharp/FSharp.Core/Query.fs

@@ -148,7 +148,7 @@ type QueryBuilder() =
             acc <- plus acc (selector e.Current)
             count <- count + 1
         if count = 0 then 
-            invalidOp "source" (System.Linq.Enumerable.Average ([| |]: int[])) // raise the same error as LINQ
+            invalidOp "source"
         LanguagePrimitives.DivideByInt< (^U) > acc count
 
     member inline __.SumBy< 'T, 'Q, ^Value 

src/fsharp/FSharp.Core/quotations.fs

@@ -1717,7 +1717,7 @@ module Patterns =
                         ci
                 let paramTypes = mi.GetParameters() |> getTypesFromParamInfos
                 Key(declaringType, tyArgsCount, methodBase.Name, paramTypes, declaringType)
-            | _ -> failwith "Unexpected MethodBase type, %A" (methodBase.GetType()) // per MSDN ConstructorInfo and MethodInfo are the only derived types from MethodBase
+            | _ -> failwithf "Unexpected MethodBase type, %A" (methodBase.GetType()) // per MSDN ConstructorInfo and MethodInfo are the only derived types from MethodBase
 #else
     [<StructuralEquality; NoComparison>]
     type ReflectedDefinitionTableKey = 

src/fsharp/PostInferenceChecks.fs

@@ -456,7 +456,7 @@ let CheckMultipleInterfaceInstantiations cenv interfaces m =
          errorR(Error(FSComp.SR.chkMultipleGenericInterfaceInstantiations((NicePrint.minimalStringOfType cenv.denv typ1), (NicePrint.minimalStringOfType cenv.denv typ2)),m))
 
 
-let rec CheckExpr   (cenv:cenv) (env:env) expr = 
+let rec CheckExpr   (cenv:cenv) (env:env) expr =
     CheckExprInContext cenv env expr GeneralContext
 
 and CheckVal (cenv:cenv) (env:env) v m context = 
@@ -583,6 +583,38 @@ 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 
+            | x -> x
+        if cenv.reportErrors then
+            let g = cenv.g
+            match f with
+            | 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, 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 -> ()
+                | _ ->
+                    ()
+            | _ ->
+                ()
+
         CheckTypeInstNoByrefs cenv env m tyargs;
         CheckTypePermitByrefs cenv env m fty;
         CheckTypeInstPermitByrefs cenv env m tyargs;

src/fsharp/TcGlobals.fs

@@ -513,6 +513,18 @@ type public TcGlobals =
       seq_empty_vref            : ValRef
       new_format_info           : IntrinsicValRef
       raise_info                : IntrinsicValRef
+      raise_vref                : ValRef
+      failwith_info             : IntrinsicValRef
+      failwith_vref             : ValRef
+      invalid_arg_info          : IntrinsicValRef
+      invalid_arg_vref          : ValRef
+      null_arg_info             : IntrinsicValRef
+      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
 
@@ -911,7 +923,13 @@ 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 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))  
   let methodhandleof_info        = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "methodhandleof"                       ,None                 ,Some "MethodHandleOf",[vara;varb],([[varaTy --> varbTy]],system_RuntimeMethodHandle_typ))
@@ -1352,6 +1370,18 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
     equals_operator_info     = equals_operator_info
 
     raise_info                 = raise_info
+    raise_vref                 = ValRefForIntrinsic raise_info
+    failwith_info              = failwith_info
+    failwith_vref              = ValRefForIntrinsic failwith_info
+    invalid_arg_info           = invalid_arg_info
+    invalid_arg_vref           = ValRefForIntrinsic invalid_arg_info
+    null_arg_info              = null_arg_info
+    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
     methodhandleof_info        = methodhandleof_info

tests/fsharpqa/Source/Diagnostics/General/W_FailwithRedundantArgs.fs

@@ -0,0 +1,5 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(4,11-4,19)" id="FS3189">Redundant arguments are being ignored in function 'failwith'\. Expected 1 but got 2 arguments\.$</Expects>
+module M
+let f() = failwith "Used" "Ignored"
+let g() = failwith "Used"

tests/fsharpqa/Source/Diagnostics/General/W_FailwithfRedundantArgs.fs

@@ -0,0 +1,8 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(4,11-4,20)" id="FS3189">Redundant arguments are being ignored in function 'failwithf'\. Expected 3 but got 4 arguments\.$</Expects>
+module M
+let f() = failwithf "Used %A %s" "this" "but not" "this"
+let g() = failwith "Used %A" "this"
+let h() =
+  let failwithf arg = Printf.ksprintf failwith arg
+  failwithf "Used" "Ignored"

tests/fsharpqa/Source/Diagnostics/General/W_InvalidArgRedundantArgs.fs

@@ -0,0 +1,8 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(6,5-6,15)" id="FS3189">Redundant arguments are being ignored in function 'invalidArg'\. Expected 2 but got 3 arguments\.$</Expects>
+module M
+type T() =
+  member __.M1 source =
+    invalidArg source "Used" "Ignored"
+  member __.M2 source =
+    invalidArg source "Used"

tests/fsharpqa/Source/Diagnostics/General/W_InvalidOpRedundantArgs.fs

@@ -0,0 +1,7 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(6,20-6,29)" id="FS3189">Redundant arguments are being ignored in function 'invalidOp'\. Expected 1 but got 2 arguments\.$</Expects>
+namespace M0
+module M1 =
+  module M2 =
+    let f source = invalidOp source "Ignored"
+    let g source = invalidOp source

tests/fsharpqa/Source/Diagnostics/General/W_NullArgRedundantArgs.fs

@@ -0,0 +1,7 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(6,17-6,24)" id="FS3189">Redundant arguments are being ignored in function 'nullArg'\. Expected 1 but got 2 arguments\.$</Expects>
+namespace M0
+module M1 =
+  module M2 =
+    let f arg = nullArg "arg" "Ignored"
+    let g arg = nullArg "arg"

tests/fsharpqa/Source/Diagnostics/General/W_RaiseRedundantArgs.fs

@@ -0,0 +1,8 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(6,5-6,10)" id="FS3189">Redundant arguments are being ignored in function 'raise'\. Expected 1 but got 2 arguments\.$</Expects>
+module M
+type T() =
+  member __.M1() =
+    raise (exn()) "Ignored"
+  member __.M2() =
+    raise (exn())

tests/fsharpqa/Source/Diagnostics/General/env.lst

@@ -118,4 +118,11 @@ ReqPP	SOURCE=E_UnxpectedMeasureAnnotation01.fs  SCFLAGS="-r:FSharp.PowerPack.dll
 ReqPP	SOURCE=W_WebExtensionsNotInPowerPack01.fs SCFLAGS="--test:ErrorRanges -r:FSharp.PowerPack.dll" COMPILE_ONLY=1		# W_WebExtensionsNotInPowerPack01.fs
 	SOURCE=E_InvalidObjectExpression01.fs     SCFLAGS="--test:ErrorRanges"	#E_InvalidObjectExpression01.fs
 
-	SOURCE=W_CreateIDisposable.fs  SCFLAGS="--test:ErrorRanges -a"	# W_CreateIDisposable.fs
+	SOURCE=W_CreateIDisposable.fs  SCFLAGS="--test:ErrorRanges -a"	# W_CreateIDisposable.fs
+
+	SOURCE=W_FailwithRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_FailwithRedundantArgs.fs
+	SOURCE=W_FailwithfRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_FailwithfRedundantArgs.fs
+	SOURCE=W_RaiseRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_RaiseRedundantArgs.fs
+	SOURCE=W_InvalidArgRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_InvalidArgRedundantArgs.fs
+	SOURCE=W_NullArgRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_NullArgRedundantArgs.fs
+	SOURCE=W_InvalidOpRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_InvalidOpRedundantArgs.fs

tests/fsharpqa/Source/test.lst

@@ -316,3 +316,4 @@ Misc02			Stress
 Misc02			XmlDoc\Basic
 Misc02			XmlDoc\OCamlDoc
 Misc02			XmlDoc\UnitOfMeasure
+Diagnostics		Diagnostics\General

vsintegration/src/Salsa/salsa.fs

@@ -1334,7 +1334,7 @@ module internal Salsa =
                         match o with
                         | (:? Microsoft.VisualStudio.FSharp.LanguageService.BraceMatch as m) -> 
                             yield (m.a, m.b)
-                        | x -> failwith "Microsoft.VisualStudio.FSharp.LanguageService.BraceMatch expected, but got %A" (if box x = null then "null" else (x.GetType()).FullName)
+                        | x -> failwithf "Microsoft.VisualStudio.FSharp.LanguageService.BraceMatch expected, but got %A" (if box x = null then "null" else (x.GetType()).FullName)
                 |]
 
 

vsintegration/src/unittests/Tests.LanguageService.ErrorList.fs

@@ -97,7 +97,7 @@ type ErrorListTests() as this =
         if (num = errorList.Length) then 
                 ()
             else
-                failwith "The error list number is not the expected %d" num
+                failwithf "The error list number is not the expected %d" num
 
     [<Test>]
     member public this.``OverloadsAndExtensionMethodsForGenericTypes``() =