Added Tests

src/fsharp/csolve.fs

@@ -1204,7 +1204,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep
                       let callerArgs = argtys |> List.map (fun argty -> CallerArg(argty,m,false,dummyExpr))
                       let minst = FreshenMethInfo m minfo
                       let objtys = minfo.GetObjArgTypes(amap, m, minst)
-                      CalledMeth<Expr>(csenv.InfoReader,None,false,FreshenMethInfo,m,AccessibleFromEverywhere,minfo,minst,minst,None,objtys,[(callerArgs,[])],false,false))
+                      CalledMeth<Expr>(csenv.InfoReader,None,false,FreshenMethInfo,m,AccessibleFromEverywhere,minfo,minst,minst,None,objtys,[(callerArgs,[])],false,false,None))
 
               let methOverloadResult,errors = 
                   CollectThenUndo (fun trace -> ResolveOverloading csenv (WithTrace(trace)) nm ndeep true (0,0) AccessibleFromEverywhere calledMethGroup false (Some rty))  

src/fsharp/tc.fs

@@ -5775,7 +5775,7 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a
             |   Some mObjTy,None -> AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env mObjTy methodName minfos 
             |   None, _ -> AfterTcOverloadResolution.DoNothing
 
-        TcMethodApplicationThen cenv env overallTy tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed 
+        TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed 
 
     | Item.DelegateCtor typ, [arg] ->
         // Re-record the name resolution since we now know it's a constructor call
@@ -6137,7 +6137,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew
                 let afterTcOverloadResolution = AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env synObjTy.Range methodName minfos
                 let ad = env.eAccessRights
 
-                let expr,tpenv = TcMethodApplicationThen cenv env objTy tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterTcOverloadResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] 
+                let expr,tpenv = TcMethodApplicationThen cenv env objTy None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterTcOverloadResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] 
                 // The 'base' value is always bound
                 let baseIdOpt = (match baseIdOpt with None -> Some(ident("base",mObjTy)) | Some id -> Some(id))
                 expr,baseIdOpt,tpenv
@@ -8018,7 +8018,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
         let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForMethods
         match delayed with 
         | (DelayedApp (atomicFlag, arg, mExprAndArg)::otherDelayed) ->
-            TcMethodApplicationThen cenv env overallTy tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
 
         | (DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: DelayedApp(atomicFlag, arg, mExprAndArg) :: otherDelayed) ->
 
@@ -8037,9 +8037,9 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
 
             // NOTE: This doesn't take instantiation into account
             CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item (* ! *), item, ItemOccurence.Use,env.DisplayEnv,env.eAccessRights)                        
-            TcMethodApplicationThen cenv env overallTy tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
         | _ -> 
-            TcMethodApplicationThen cenv env overallTy tpenv None [] mItem mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [] ExprAtomicFlag.Atomic delayed 
+            TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [] ExprAtomicFlag.Atomic delayed 
 
     | Item.CtorGroup(nm,minfos) ->
         let objTy = 
@@ -8206,14 +8206,14 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
             if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos
             // Note: static calls never mutate a struct object argument
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed
         | _ -> 
             // Static Property Get (possibly indexer) 
             let meths = pinfos |> GettersOfPropInfos
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos
             if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem))
             // Note: static calls never mutate a struct object argument
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse args ExprAtomicFlag.Atomic delayed
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse args ExprAtomicFlag.Atomic delayed
 
     | Item.ILField finfo -> 
 
@@ -8352,7 +8352,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
         let tyargsOpt,tpenv = TcMemberTyArgsOpt cenv env tpenv tyargsOpt
         let meths = minfos |> List.map (fun minfo -> minfo,None) 
 
-        TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
+        TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
 
     | Item.Property (nm,pinfos) ->
         // Instance property 
@@ -8377,13 +8377,13 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
             if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos
             let mut = (if isStructTy cenv.g (tyOfExpr cenv.g objExpr) then DefinitelyMutates else PossiblyMutates)
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterTcOverloadResolution NormalValUse (args @ [e2]) atomicFlag [] 
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterTcOverloadResolution NormalValUse (args @ [e2]) atomicFlag [] 
         | _ ->                   
             // Instance property getter
             let meths = GettersOfPropInfos pinfos
             if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
 
     | Item.RecdField rfinfo ->
         // Get or set instance F# field or literal 
@@ -8488,6 +8488,7 @@ and TcMethodApplicationThen
        env
        overallTy           // The type of the overall expression including "delayed". THe method "application" may actually be a use of a member as 
                     // a first-class function value, when this would be a function type. 
+       objTyOpt   // methodType
        tpenv 
        callerTyArgs // The return type of the overall expression including "delayed" 
        objArgs      // The 'obj' arguments in obj.M(...) and obj.M, if any 
@@ -8514,7 +8515,7 @@ and TcMethodApplicationThen
 
     // Call the helper below to do the real checking 
     let (expr,attributeAssignedNamedItems,delayed),tpenv = 
-        TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName ad mut isProp meths afterTcOverloadResolution isSuperInit args exprTy delayed
+        TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterTcOverloadResolution isSuperInit args exprTy delayed
 
     // Give errors if some things couldn't be assigned 
     if nonNil attributeAssignedNamedItems then 
@@ -8545,6 +8546,7 @@ and TcMethodApplication
         mMethExpr  // range of the entire method expression 
         mItem
         methodName 
+         (objTyOpt : TType option)
         ad 
         mut 
         isProp 
@@ -8741,7 +8743,7 @@ and TcMethodApplication
                 | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                 | None -> minst
             let allArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs
-            CalledMeth<SynExpr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,allArgs,usesParamArrayConversion,true)
+            CalledMeth<SynExpr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,allArgs,usesParamArrayConversion,true,objTyOpt)
 
         let preArgumentTypeCheckingCalledMethGroup = 
             [ for (minfo,pinfoOpt) in candidateMethsAndProps do
@@ -8834,7 +8836,7 @@ and TcMethodApplication
                     | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                     | None -> minst
                 let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs
-                CalledMeth<Expr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true))
+                CalledMeth<Expr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt))
 
         let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length)
         let csenv = MakeConstraintSolverEnv cenv.css mMethExpr denv
@@ -9713,7 +9715,7 @@ and TcAttribute cenv (env: TcEnv) attrTgt (synAttr: SynAttribute)  =
                 let meths = minfos |> List.map (fun minfo -> minfo,None) 
                 let afterTcOverloadResolution = AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos
                 let (expr,namedCallerArgs,_),_ = 
-                  TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName ad PossiblyMutates false meths afterTcOverloadResolution NormalValUse [arg] (NewInferenceType ())  []
+                  TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterTcOverloadResolution NormalValUse [arg] (NewInferenceType ())  []
 
                 UnifyTypes cenv env mAttr ty (tyOfExpr cenv.g expr)
 

src/fsharp/typrelns.fs

@@ -1643,7 +1643,8 @@ type CalledMeth<'T>
        callerObjArgTys: TType list,   // the types of the actual object argument, if any 
        curriedCallerArgs: (CallerArg<'T> list * CallerNamedArg<'T> list) list,     // the data about any arguments supplied by the caller 
        allowParamArgs:bool,       // do we allow the use of a param args method in its "expanded" form?
-       allowOutAndOptArgs: bool)  // do we allow the use of the transformation that converts out arguments as tuple returns?
+       allowOutAndOptArgs: bool,  // do we allow the use of the transformation that converts out arguments as tuple returns?
+       tyargsOpt : TType option) // method parameters
     =
     let g = infoReader.g
     let methodRetTy = minfo.GetFSharpReturnTy(infoReader.amap, m, calledTyArgs)
@@ -1738,6 +1739,10 @@ type CalledMeth<'T>
                             let pminst = match minfo with
                                          | MethInfo.FSMeth(_,TType.TType_app(_,types),_,_) -> types
                                          | _ -> freshenMethInfo m pminfo
+
+                            let pminst = match tyargsOpt with
+                                          | Some(TType.TType_app(_, types)) -> types
+                                          | _ -> pminst
                             Choice1Of2(AssignedItemSetter(id,AssignedPropSetter(pinfo,pminfo, pminst), e))
                         |  _ ->    
                             match infoReader.GetILFieldInfosOfType(Some(nm),ad,m,returnedObjTy) with

tests/RunTests.cmd

@@ -157,7 +157,7 @@ if errorlevel 1 (
 
 pushd %~dp0\fsharpqa\source
 echo perl %~dp0\fsharpqa\testenv\bin\runall.pl -resultsroot %RESULTSDIR% -results %RESULTFILE% -log %FAILFILE% -fail %FAILENV% -cleanup:yes %TTAGS_ARG% %NO_TTAGS_ARG% %PARALLEL_ARG%
-     perl %~dp0\fsharpqa\testenv\bin\runall.pl -resultsroot %RESULTSDIR% -results %RESULTFILE% -log %FAILFILE% -fail %FAILENV% -cleanup:yes %TTAGS_ARG% %NO_TTAGS_ARG% %PARALLEL_ARG%
+     perl %~dp0\fsharpqa\testenv\bin\runall.pl -resultsroot %RESULTSDIR% -results %RESULTFILE% -log %FAILFILE% -fail %FAILENV% -cleanup:no %TTAGS_ARG% %NO_TTAGS_ARG% %PARALLEL_ARG%
 
 popd
 goto :EOF
@@ -196,4 +196,4 @@ xcopy /y "%nunitlocation%\lib\*.dll" "%FSCBINPATH%"
 echo nunit-console-x86.exe /nologo /result=%XMLFILE% /output=%OUTPUTFILE% /err=%ERRORFILE% /work=%RESULTSDIR% %FSCBINPATH%\Unittests.dll 
      nunit-console-x86.exe /nologo /result=%XMLFILE% /output=%OUTPUTFILE% /err=%ERRORFILE% /work=%RESULTSDIR% %FSCBINPATH%\Unittests.dll 
 
-goto :EOF
+goto :EOF

tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/NamedArguments/PropertySetterAfterConstruction01NamedExtensionsInheritance.fs

@@ -1,8 +1,6 @@
 // #Regression #Conformance #DeclarationElements #MemberDefinitions #NamedArguments 
 #light
 
-// FSB 1368, named arguments implicitly using property setters for generic class do not typecheck correctly
-
 module GenericInheritedClass2 =
     type R =
         class
@@ -28,8 +26,7 @@ module GenericInheritedClassExt2 =
         member x.C with set v =  v |> Seq.iter x.w.Add 
 
     // Standard construction
-    let x1 = GenericInheritedClass2.S(1,"1",A = 2, B = "2",C = [ 3] )
-
+    let x1 = GenericInheritedClass2.S(1,"1", A = 2, B = "2",C = [ 3] )
     if x1.x <> 3   then exit 1
     if x1.y <> "21" then exit 1
     if x1.w.Count <> 1 then exit 1

tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/NamedArguments/PropertySetterAfterConstruction01NamedExtensionsOptional.fs

@@ -0,0 +1,36 @@
+// #Regression #Conformance #DeclarationElements #MemberDefinitions #NamedArguments 
+#light
+
+
+module GenericClass =
+    type S<'a,'b> =
+        class
+           val mutable x : 'a
+           val mutable y : 'b
+           member obj.X with set(v) = obj.x <- v
+           member obj.Y with set(v) = obj.y <- v
+           new(a,b) = { x=a; y=b }
+        end
+    type S<'a,'b> with
+        member x.XProxyIntrinsic with set (v:'a) = x.X  <- v
+        member x.YProxyIntrinsic with set (v:'b) = x.Y  <- v
+module GenericClassExt =
+
+    module Extensions =
+        open GenericClass
+        type S<'a,'b> with
+            member x.XProxyOptional with set (v:'a) = x.X  <- v
+            member x.YProxyOptional with set (v:'b) = x.Y  <- v
+
+module Test =
+    open GenericClassExt.Extensions
+    open GenericClass
+    let x1 = S<_,_>(1,"1", XProxyIntrinsic = 44, YProxyIntrinsic = "44")
+    if x1.x <> 44   then exit 1
+    if x1.y <> "44" then exit 1
+
+    let x3 = S<_,_>(1,"1", XProxyOptional = 44, YProxyOptional = "44")
+    if x3.x <> 44   then exit 1
+    if x3.y <> "44" then exit 1
+
+    exit 0

tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/NamedArguments/PropertySetterAfterConstruction02NamedExtensions.fs

@@ -21,7 +21,7 @@ module GenericClass =
             member x.YProxyOptional with set (v:'b) = x.Y  <- v
 
     open Extensions
-
+ 
     // Standard construction
     let x1 = S<int,string>(1,"1", XProxyIntrinsic = 42, YProxyIntrinsic = "42")
     if x1.x <> 42   then exit 1
@@ -32,9 +32,8 @@ module GenericClass =
     x2.YProxyOptional <- "43"
     if x2.x <> 43   then exit 1
     if x2.y <> "43" then exit 1
-
+ 
     let x3 = S<_,_>(1,"1", XProxyOptional = 44, YProxyOptional = "44")
     if x3.x <> 44   then exit 1
     if x3.y <> "44" then exit 1
     exit 0
-

tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/NamedArguments/env.lst

@@ -7,10 +7,11 @@
 	SOURCE=mixNamedNonNamed.fs		# mixNamedNonNamed.fs
 	SOURCE=refLibsHaveNamedParams.fs	# refLibsHaveNamedParams.fs
 	SOURCE=E_NumParamMismatch01.fs		# E_NumParamMismatch01.fs
-	SOURCE=PropertySetterAfterConstruction01.fs	# PropertySetterAfterConstruction01.fs
-	SOURCE=PropertySetterAfterConstruction01NamedExtensions.fs	# PropertySetterAfterConstruction01NamedExtensions.fs
+	SOURCE=PropertySetterAfterConstruction01NamedExtensions.fs	# PropertySetterAfterConstructionNamed01Extensions.fs
 	SOURCE=PropertySetterAfterConstruction01NamedExtensionsInheritance.fs	# PropertySetterAfterConstruction01NamedExtensionsInheritance.fs
-	SOURCE=PropertySetterAfterConstruction02.fs	# PropertySetterAfterConstruction02.fs
+	SOURCE=PropertySetterAfterConstruction01NamedExtensionsOptional.fs	# PropertySetterAfterConstruction01NamedExtensionsOptional.fs	
+	SOURCE=PropertySetterAfterConstruction02NamedExtensions.fs	# PropertySetterAfterConstruction02NamedExtensions.fs
+        SOURCE=PropertySetterAfterConstruction01.fs	# PropertySetterAfterConstruction01.fs
+        SOURCE=PropertySetterAfterConstruction02.fs	# PropertySetterAfterConstruction02.fs
 	SOURCE=E_MisspeltParam01.fs		# E_MisspeltParam01.fs
-
 	SOURCE=E_MustBePrefix.fs		# E_MustBePrefix.fs

tests/fsharpqa/Source/test.lst

@@ -109,6 +109,8 @@ Conformance02			Conformance\DeclarationElements\ModuleAbbreviations
 Conformance02			Conformance\DeclarationElements\ObjectConstructors
 Conformance02			Conformance\DeclarationElements\P-invokeDeclarations
 
+Conformance02.2			Conformance\DeclarationElements\MemberDefinitions\NamedArguments
+
 Conformance03			Conformance\Expressions\ApplicationExpressions\Assertion
 Conformance03			Conformance\Expressions\ApplicationExpressions\BasicApplication
 Conformance03			Conformance\Expressions\ApplicationExpressions\ObjectConstruction