Fix 681 - Compiler error when passing named parameters to attributes (#3251)

src/fsharp/MethodCalls.fs

@@ -286,25 +286,25 @@ type CalledMeth<'T>
                             else None) 
                     | _ -> None)
 
-            let unassignedNamedItem = 
+            let unassignedNamedItems = 
                 namedCallerArgs |> List.filter (fun (CallerNamedArg(nm,_e)) -> 
                     fullCalledArgs |> List.forall (fun calledArg -> 
                         match calledArg.NameOpt with 
                         | Some nm2 -> nm.idText <> nm2.idText
                         | None -> true))
 
-            let attributeAssignedNamedItems,unassignedNamedItem = 
+            let attributeAssignedNamedItems = 
                 if isCheckingAttributeCall then 
-                    // the assignment of names to properties is substantially for attribute specifications 
-                    // permits bindings of names to non-mutable fields and properties, so we do that using the old 
-                    // reliable code for this later on. 
-                    unassignedNamedItem,[]
+                    // The process for assigning names-->properties is substantially different for attribute specifications 
+                    // because it permits the bindings of names to immutable fields. So we use the old 
+                    // code for this.
+                    unassignedNamedItems
                  else 
-                    [],unassignedNamedItem
+                    []
 
-            let assignedNamedProps,unassignedNamedItem = 
+            let assignedNamedProps,unassignedNamedItems = 
                 let returnedObjTy = if minfo.IsConstructor then minfo.EnclosingType else methodRetTy
-                unassignedNamedItem |> List.splitChoose (fun (CallerNamedArg(id,e) as arg) -> 
+                unassignedNamedItems |> List.splitChoose (fun (CallerNamedArg(id,e) as arg) -> 
                     let nm = id.idText
                     let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (Some(nm),ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides id.idRange returnedObjTy
                     let pinfos = pinfos |> ExcludeHiddenOfPropInfos g infoReader.amap m 
@@ -347,7 +347,7 @@ type CalledMeth<'T>
                 
             let argSet = { UnnamedCalledArgs=unnamedCalledArgs; UnnamedCallerArgs=unnamedCallerArgs; ParamArrayCalledArgOpt=paramArrayCalledArgOpt; ParamArrayCallerArgs=paramArrayCallerArgs; AssignedNamedArgs=assignedNamedArgs }
 
-            (argSet,assignedNamedProps,unassignedNamedItem,attributeAssignedNamedItems,unnamedCalledOptArgs,unnamedCalledOutArgs))
+            (argSet,assignedNamedProps,unassignedNamedItems,attributeAssignedNamedItems,unnamedCalledOptArgs,unnamedCalledOutArgs))
 
     let argSets                     = argSetInfos |> List.map     (fun (x,_,_,_,_,_) -> x)
     let assignedNamedProps          = argSetInfos |> List.collect (fun (_,x,_,_,_,_) -> x)

src/fsharp/TypeChecker.fs

@@ -9178,7 +9178,7 @@ and GetNewInferenceTypeForMethodArg cenv env tpenv x =
 
 /// Method calls, property lookups, attribute constructions etc. get checked through here 
 and TcMethodApplication 
-        checkingAttributeCall 
+        isCheckingAttributeCall 
         cenv 
         env 
         tpenv 
@@ -9384,7 +9384,7 @@ and TcMethodApplication
                 match tyargsOpt with 
                 | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                 | None -> minst
-            CalledMeth<SynExpr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt)
+            CalledMeth<SynExpr>(cenv.infoReader,Some(env.NameEnv),isCheckingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt)
 
         let preArgumentTypeCheckingCalledMethGroup = 
             [ for (minfo,pinfoOpt) in candidateMethsAndProps do
@@ -9483,7 +9483,7 @@ and TcMethodApplication
                     match tyargsOpt with 
                     | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                     | None -> minst
-                CalledMeth<Expr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt))
+                CalledMeth<Expr>(cenv.infoReader,Some(env.NameEnv),isCheckingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt))
           
         let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length)
         let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv
@@ -9859,6 +9859,7 @@ and TcMethodApplication
 
     // Handle post-hoc property assignments 
     let expr = 
+        if isCheckingAttributeCall then expr else
         if isNil finalAssignedItemSetters then expr else 
         // This holds the result of the call 
         let objv,objExpr = mkMutableCompGenLocal mMethExpr "returnVal" exprty // mutable in case it's a struct 
@@ -10531,7 +10532,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute)  =
             | Item.CtorGroup(methodName,minfos) ->
                 let meths = minfos |> List.map (fun minfo -> minfo,None) 
                 let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos
-                let (expr,namedCallerArgs,_),_ = 
+                let (expr,attributeAssignedNamedItems,_),_ = 
                   TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (NewInferenceType ())  []
 
                 UnifyTypes cenv env mAttr ty (tyOfExpr cenv.g expr)
@@ -10540,9 +10541,9 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute)  =
                     AttribExpr(e,EvalLiteralExprOrAttribArg cenv.g e)
 
                 let namedAttribArgMap = 
-                  namedCallerArgs |> List.map (fun (CallerNamedArg(id,CallerArg(argtyv,m,isOpt,expr))) ->
+                  attributeAssignedNamedItems |> List.map (fun (CallerNamedArg(id,CallerArg(argtyv,m,isOpt,callerArgExpr))) ->
                     if isOpt then error(Error(FSComp.SR.tcOptionalArgumentsCannotBeUsedInCustomAttribute(),m))
-                    let m = expr.Range
+                    let m = callerArgExpr.Range
                     let setterItem, _ = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr m ad [id] IgnoreOverrides TypeNameResolutionInfo.Default ty
                     let nm, isProp, argty = 
                       match setterItem with   
@@ -10568,7 +10569,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute)  =
 
                     AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace argty argtyv
 
-                    AttribNamedArg(nm,argty,isProp,mkAttribExpr expr))
+                    AttribNamedArg(nm,argty,isProp,mkAttribExpr callerArgExpr))
 
                 match expr with 
                 | Expr.Op(TOp.ILCall(_,_,valu,_,_,_,_,ilMethRef,[],[],_rtys),[],args,m) -> 

tests/fsharp/core/attributes/test.fsx

@@ -1323,6 +1323,15 @@ module TestFsiLoadOfNonExistentAssembly =
 
     do test()
 
+// See https://github.com/Microsoft/visualfsharp/issues/681
+module BugWithOverloadedAttributes = 
+
+    type FooAttribute(value : int) =
+        inherit System.Attribute()
+        new () = new FooAttribute(-1)
+
+    [<FooAttribute(value = 42)>]
+    type Bar = class end
 
 (*-------------------------------------------------------------------------
 !* Test passed?