From eb2f28287a657087782fd12e0e0f85dab160b881 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 30 Oct 2020 14:57:38 +0000 Subject: [PATCH] further testing for FCS on List.sum on non-primitive type --- src/fsharp/symbols/Symbols.fs | 30 +- src/fsharp/symbols/Symbols.fsi | 4 +- .../SurfaceArea.netstandard.fs | 2 +- tests/service/ExprTests.fs | 326 +++++++++++------- 4 files changed, 221 insertions(+), 141 deletions(-) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 80afaa52814d..59b36bcc0d41 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -1879,7 +1879,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } - yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional) ] + yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional, false) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection @@ -1891,7 +1891,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } - yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional) ] + yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional, false) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection @@ -1923,7 +1923,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = let isInArg = HasFSharpAttribute cenv.g cenv.g.attrib_InAttribute argInfo.Attribs && isByrefTy cenv.g argty let isOutArg = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute argInfo.Attribs && isByrefTy cenv.g argty let isOptionalArg = HasFSharpAttribute cenv.g cenv.g.attrib_OptionalArgumentAttribute argInfo.Attribs - yield FSharpParameter(cenv, argty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) ] + yield FSharpParameter(cenv, argty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg, false) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection @@ -2115,11 +2115,17 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | [] -> None | _ when not (cenv.g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing)) -> None | _ -> - let g = cenv.g - let witnessTys = GenWitnessTys g witnessInfos - let tys = witnessTys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + let witnessParams = + ((Set.empty, 0), witnessInfos) ||> List.mapFold (fun (used,i) witnessInfo -> + let paramTy = GenWitnessTy cenv.g witnessInfo + let nm = String.uncapitalize witnessInfo.MemberName + let nm = if used.Contains nm then nm + string i else nm + let argReprInfo : ArgReprInfo = { Attribs=[]; Name=Some (mkSynId x.DeclarationLocation nm) } + let p = FSharpParameter(cenv, paramTy, argReprInfo, None, None, false, false, false, false, true) + p, (used.Add nm, i + 1)) + |> fst let witnessMethName = PrettyNaming.ExtraWitnessMethodName x.CompiledName - Some (witnessMethName, tys) + Some (witnessMethName, makeReadOnlyCollection witnessParams) type FSharpType(cenv, ty:TType) = @@ -2416,7 +2422,7 @@ type FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterI "static parameter " + x.Name #endif -type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) = +type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg, isWitnessArg) = inherit FSharpSymbol(cenv, (fun () -> let m = defaultArg ownerRangeOpt range0 @@ -2426,16 +2432,16 @@ type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ow new (cenv, id, ty, container) = let argInfo: ArgReprInfo = { Name = Some id; Attribs = [] } - FSharpParameter(cenv, ty, argInfo, container, None, false, false, false, false) + FSharpParameter(cenv, ty, argInfo, container, None, false, false, false, false, false) new (cenv, ty, argInfo: ArgReprInfo, ownerRangeOpt) = - FSharpParameter(cenv, ty, argInfo, None, ownerRangeOpt, false, false, false, false) + FSharpParameter(cenv, ty, argInfo, None, ownerRangeOpt, false, false, false, false, false) member _.Name = match topArgInfo.Name with None -> None | Some v -> Some v.idText member _.cenv: SymbolEnv = cenv - member _.AdjustType ty = FSharpParameter(cenv, ty, topArgInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) + member _.AdjustType ty = FSharpParameter(cenv, ty, topArgInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg, isWitnessArg) member _.Type: FSharpType = FSharpType(cenv, paramTy) @@ -2466,6 +2472,8 @@ type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ow member _.IsOptionalArg = isOptionalArg + member _.IsWitnessArg = isWitnessArg + member private x.ValReprInfo = topArgInfo override x.Equals(other: obj) = diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index f84dfbb4a391..f364f2c1f36d 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -908,8 +908,8 @@ type FSharpMemberOrFunctionOrValue = member FormatLayout: context: FSharpDisplayContext -> Layout /// Check if this method has an entrpoint that accepts witness arguments and if so return - /// the name of that entrypoint and the types of the witness arguments - member GetWitnessPassingInfo: unit -> (string * IList) option + /// the name of that entrypoint and information about the additional witness arguments + member GetWitnessPassingInfo: unit -> (string * IList) option /// A subtype of FSharpSymbol that represents a parameter [] diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index 49b5e69aa16f..5bebc9201d04 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -22538,7 +22538,7 @@ FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: System.String FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: System.String get_XmlDocSig() FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: range DeclarationLocation FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: range get_DeclarationLocation() -FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[System.String,System.Collections.Generic.IList`1[FSharp.Compiler.SourceCodeServices.FSharpType]]] GetWitnessPassingInfo() +FSharp.Compiler.SourceCodeServices.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[System.String,System.Collections.Generic.IList`1[FSharp.Compiler.SourceCodeServices.FSharpParameter]]] GetWitnessPassingInfo() FSharp.Compiler.SourceCodeServices.FSharpMethodGroup: FSharp.Compiler.SourceCodeServices.FSharpMethodGroupItem[] Methods FSharp.Compiler.SourceCodeServices.FSharpMethodGroup: FSharp.Compiler.SourceCodeServices.FSharpMethodGroupItem[] get_Methods() FSharp.Compiler.SourceCodeServices.FSharpMethodGroup: System.String MethodName diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 36bdc97a7dc2..120d3708d773 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -64,19 +64,20 @@ module internal Utils = /// Clean up after a test is run. If you need to inspect the create *.fs files, change this function to do nothing, or just break here. let cleanupTempFiles files = - for fileName in files do - try - // cleanup: only the source file is written to the temp dir. - File.Delete fileName - with _ -> () - - try - // remove the dir when empty - let tempPath = getTempPath() - if Directory.GetFiles tempPath |> Array.isEmpty then - Directory.Delete tempPath - with _ -> () - + { new System.IDisposable with + member _.Dispose() = + for fileName in files do + try + // cleanup: only the source file is written to the temp dir. + File.Delete fileName + with _ -> () + + try + // remove the dir when empty + let tempPath = getTempPath() + if Directory.GetFiles tempPath |> Array.isEmpty then + Directory.Delete tempPath + with _ -> () } /// Given just a filename, returns it with changed extension located in %TEMP%\ExprTests let getTempFilePathChangeExt tmp ext = @@ -350,6 +351,21 @@ module internal Utils = } +let createOptionsAux fileSources extraArgs = + let fileNames = fileSources |> List.map (fun _ -> Utils.getTempFileName()) + let temp2 = Utils.getTempFileName() + let fileNames = fileNames |> List.map (fun temp1 -> Utils.getTempFilePathChangeExt temp1 ".fs") + let dllName = Utils.getTempFilePathChangeExt temp2 ".dll" + let projFileName = Utils.getTempFilePathChangeExt temp2 ".fsproj" + + Utils.createTempDir() + for (fileSource, fileName) in List.zip fileSources fileNames do + File.WriteAllText(fileName, fileSource) + let args = [| yield! extraArgs; yield! mkProjectCommandLineArgs (dllName, fileNames) |] + let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + + Utils.cleanupTempFiles (fileNames @ [dllName; projFileName]), options + //--------------------------------------------------------------------------------------------------------- // This project is a smoke test for a whole range of standard and obscure expressions @@ -642,27 +658,7 @@ let testMutableVar = mutableVar 1 let testMutableConst = mutableConst () """ - let createOptions() = - let temp1 = Utils.getTempFileName() - let temp2 = Utils.getTempFileName() - let fileName1 = Utils.getTempFilePathChangeExt temp1 ".fs" // Path.ChangeExtension(Path.GetTempFileName(), ".fs") - let fileName2 = Utils.getTempFilePathChangeExt temp2 ".fs" //Path.ChangeExtension(base2, ".fs") - let dllName = Utils.getTempFilePathChangeExt temp2 ".dll" //Path.ChangeExtension(base2, ".dll") - let projFileName = Utils.getTempFilePathChangeExt temp2 ".fsproj" //Path.ChangeExtension(base2, ".fsproj") - - Utils.createTempDir() - File.WriteAllText(fileName1, fileSource1) - File.WriteAllText(fileName2, fileSource2) - let fileNames = [fileName1; fileName2] - let args = mkProjectCommandLineArgs (dllName, fileNames) - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - - [fileName1; fileName2; dllName; projFileName], options - - let options = lazy createOptions() - - - + let createOptions() = createOptionsAux [fileSource1; fileSource2] [] let operatorTests = """ module OperatorTests{0} @@ -724,8 +720,11 @@ let test{0}ToStringOperator (e1:{1}) = string e1 """ /// This test is run in unison with its optimized counterpart below +[] let ``Test Unoptimized Declarations Project1`` () = - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd Project1.options.Value) |> Async.RunSynchronously + let cleanup, options = Project1.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously for e in wholeProjectResults.Errors do printfn "Project1 error: <<<%s>>>" e.Message @@ -855,9 +854,11 @@ let ``Test Unoptimized Declarations Project1`` () = () -/// This test is run in unison with its unoptimized counterpart below +[] let ``Test Optimized Declarations Project1`` () = - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd Project1.options.Value) |> Async.RunSynchronously + let cleanup, options = Project1.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously for e in wholeProjectResults.Errors do printfn "Project1 error: <<<%s>>>" e.Message @@ -988,15 +989,6 @@ let ``Test Optimized Declarations Project1`` () = () -[] -let ``Test Optimized and Unoptimized Declarations for Project1`` () = - let filenames = fst Project1.options.Value - try - ``Test Optimized Declarations Project1`` () - ``Test Unoptimized Declarations Project1`` () - finally - Utils.cleanupTempFiles filenames - let testOperators dnName fsName excludedTests expectedUnoptimized expectedOptimized = let tempFileName = Utils.getTempFileName() @@ -1004,7 +996,8 @@ let testOperators dnName fsName excludedTests expectedUnoptimized expectedOptimi let dllPath =Utils.getTempFilePathChangeExt tempFileName ".dll" let projFilePath = Utils.getTempFilePathChangeExt tempFileName ".fsproj" - try + begin + use _cleanup = Utils.cleanupTempFiles [filePath; dllPath; projFilePath] createTempDir() let source = System.String.Format(Project1.operatorTests, dnName, fsName) let replace (s:string) r = s.Replace("let " + r, "// let " + r) @@ -1104,11 +1097,7 @@ let testOperators dnName fsName excludedTests expectedUnoptimized expectedOptimi // fail test on first line that fails, show difference in output window resultOptFiltered |> shouldPairwiseEqual expectedOptFiltered - - finally - Utils.cleanupTempFiles [filePath; dllPath; projFilePath] - - () + end [] let ``Test Operator Declarations for Byte`` () = @@ -3002,28 +2991,14 @@ let BigSequenceExpression(outFileOpt,docFileOpt,baseAddressOpt) = """ - let createOptions() = - let temp1 = Utils.getTempFileName() - let temp2 = Utils.getTempFileName() - let fileName1 = Utils.getTempFilePathChangeExt temp1 ".fs" //Path.ChangeExtension(Path.GetTempFileName(), ".fs") - let dllName = Utils.getTempFilePathChangeExt temp2 ".dll" //Path.ChangeExtension(base2, ".dll") - let projFileName = Utils.getTempFilePathChangeExt temp2 ".fsproj" //Path.ChangeExtension(base2, ".fsproj") + let createOptions() = createOptionsAux [fileSource1] [] - Utils.createTempDir() - File.WriteAllText(fileName1, fileSource1) - let fileNames = [fileName1] - let args = mkProjectCommandLineArgs (dllName, fileNames) - let options = exprChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - - [fileName1; dllName; projFileName], options - - let options = lazy createOptions() - - -/// This test is run in unison with its optimized counterpart below +[] let ``Test expressions of declarations stress big expressions`` () = - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd ProjectStressBigExpressions.options.Value) |> Async.RunSynchronously + let cleanup, options = ProjectStressBigExpressions.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously wholeProjectResults.Errors.Length |> shouldEqual 0 @@ -3034,9 +3009,11 @@ let ``Test expressions of declarations stress big expressions`` () = printDeclarations None (List.ofSeq file1.Declarations) |> Seq.toList |> ignore -/// This test is run in unison with its unoptimized counterpart below +[] let ``Test expressions of optimized declarations stress big expressions`` () = - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd ProjectStressBigExpressions.options.Value) |> Async.RunSynchronously + let cleanup, options = ProjectStressBigExpressions.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously wholeProjectResults.Errors.Length |> shouldEqual 0 @@ -3046,19 +3023,10 @@ let ``Test expressions of optimized declarations stress big expressions`` () = // This should not stack overflow printDeclarations None (List.ofSeq file1.Declarations) |> Seq.toList |> ignore -[] -let ``Test expressions of both optimized and unoptimized declarations for StressTest Big Expressions`` () = - let filenames = fst ProjectStressBigExpressions.options.Value - try - ``Test expressions of optimized declarations stress big expressions`` () - ``Test expressions of declarations stress big expressions`` () - finally - Utils.cleanupTempFiles filenames - //--------------------------------------------------------------------------------------------------------- // This project is for witness arguments (CallWithWitnesses) -module internal ProjectForWitnesses = +module internal ProjectForWitnesses1 = let fileSource1 = """ module M @@ -3098,28 +3066,13 @@ let f7() = callXY (C()) (D()) let f8() = callXY (D()) (C()) """ - let createOptions() = - let temp1 = Utils.getTempFileName() - let temp2 = Utils.getTempFileName() - let fileName1 = Utils.getTempFilePathChangeExt temp1 ".fs" - let dllName = Utils.getTempFilePathChangeExt temp2 ".dll" - let projFileName = Utils.getTempFilePathChangeExt temp2 ".fsproj" - - Utils.createTempDir() - File.WriteAllText(fileName1, fileSource1) - let fileNames = [fileName1] - let args = [| yield "--langversion:preview"; yield! mkProjectCommandLineArgs (dllName, fileNames) |] - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - - [fileName1; dllName; projFileName], options - - let options = lazy createOptions() + let createOptions() = createOptionsAux [fileSource1] ["--langversion:preview"] [] -let ``Test ProjectForWitnesses`` () = - let filenames = fst ProjectForWitnesses.options.Value - try - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd ProjectForWitnesses.options.Value) |> Async.RunSynchronously +let ``Test ProjectForWitnesses1`` () = + let cleanup, options = ProjectForWitnesses1.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously for e in wholeProjectResults.Errors do printfn "Project1 error: <<<%s>>>" e.Message @@ -3157,8 +3110,57 @@ let ``Test ProjectForWitnesses`` () = actual |> shouldPairwiseEqual expected - finally - Utils.cleanupTempFiles filenames + +[] +let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = + let cleanup, options = ProjectForWitnesses1.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + + for e in wholeProjectResults.Errors do + printfn "ProjectForWitnesses1 error: <<<%s>>>" e.Message + + begin + let symbol = + wholeProjectResults.GetAllUsesOfAllSymbols() + |> Array.tryFind (fun su -> su.Symbol.DisplayName = "callX") + |> Option.orElseWith (fun _ -> failwith "Could not get symbol") + |> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue) + |> Option.get + printfn "symbol = %s" symbol.FullName + let wpi = (symbol.GetWitnessPassingInfo()) + match wpi with + | None -> failwith "witness passing info expected" + | Some (nm, argTypes) -> + nm |> shouldEqual "callX$W" + argTypes.Count |> shouldEqual 1 + let argText = argTypes.[0].Type.ToString() + argText |> shouldEqual "type ^T -> ^U -> ^V" + end + + + begin + let symbol = + wholeProjectResults.GetAllUsesOfAllSymbols() + |> Array.tryFind (fun su -> su.Symbol.DisplayName = "callXY") + |> Option.orElseWith (fun _ -> failwith "Could not get symbol") + |> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue) + |> Option.get + printfn "symbol = %s" symbol.FullName + let wpi = (symbol.GetWitnessPassingInfo()) + match wpi with + | None -> failwith "witness passing info expected" + | Some (nm, argTypes) -> + nm |> shouldEqual "callXY$W" + argTypes.Count |> shouldEqual 2 + let argName1 = argTypes.[0].Name + let argText1 = argTypes.[0].Type.ToString() + let argName2 = argTypes.[1].Name + let argText2 = argTypes.[1].Type.ToString() + argText1 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + argText2 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + end + //--------------------------------------------------------------------------------------------------------- // This project is for witness arguments (CallWithWitnesses) @@ -3186,32 +3188,18 @@ type MyNumberWrapper = { MyNumber: MyNumber } """ - let createOptions() = - let temp1 = Utils.getTempFileName() - let temp2 = Utils.getTempFileName() - let fileName1 = Utils.getTempFilePathChangeExt temp1 ".fs" - let dllName = Utils.getTempFilePathChangeExt temp2 ".dll" - let projFileName = Utils.getTempFilePathChangeExt temp2 ".fsproj" - - Utils.createTempDir() - File.WriteAllText(fileName1, fileSource1) - let fileNames = [fileName1] - let args = [| yield "--langversion:preview"; yield! mkProjectCommandLineArgs (dllName, fileNames) |] - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - - [fileName1; dllName; projFileName], options - - let options = lazy createOptions() + let createOptions() = createOptionsAux [fileSource1] ["--langversion:preview"] [] let ``Test ProjectForWitnesses2`` () = - let filenames = fst ProjectForWitnesses2.options.Value - try - let wholeProjectResults = exprChecker.ParseAndCheckProject(snd ProjectForWitnesses2.options.Value) |> Async.RunSynchronously + let cleanup, options = ProjectForWitnesses2.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously for e in wholeProjectResults.Errors do - printfn "Project1 error: <<<%s>>>" e.Message + printfn "ProjectForWitnesses2 error: <<<%s>>>" e.Message + wholeProjectResults.Errors.Length |> shouldEqual 0 wholeProjectResults.AssemblyContents.ImplementationFiles.Length |> shouldEqual 1 let file1 = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] @@ -3232,6 +3220,90 @@ let ``Test ProjectForWitnesses2`` () = actual |> shouldPairwiseEqual expected - finally - Utils.cleanupTempFiles filenames +//--------------------------------------------------------------------------------------------------------- +// This project is for witness arguments, testing for https://github.com/dotnet/fsharp/issues/10364 + +module internal ProjectForWitnesses3 = + + let fileSource1 = """ +module M + +type Point = + { x: int; y: int } + static member Zero = { x=0; y=0 } + member p.Sign = sign p.x + + static member (+) (p1, p2) = { x= p1.x + p2.x; y = p1.y + p2.y } + +let p1 = {x=1; y=10} +let p2 = {x=2; y=20} +let s = List.sum [p1; p2] +let s2 = sign p1 + + """ + + let createOptions() = createOptionsAux [fileSource1] ["--langversion:preview"] + +[] +let ``Test ProjectForWitnesses3`` () = + let cleanup, options = createOptionsAux [ ProjectForWitnesses3.fileSource1 ] ["--langversion:preview"] + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + + for e in wholeProjectResults.Errors do + printfn "ProjectForWitnesses3 error: <<<%s>>>" e.Message + + wholeProjectResults.Errors.Length |> shouldEqual 0 + wholeProjectResults.AssemblyContents.ImplementationFiles.Length |> shouldEqual 1 + let file1 = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] + + let expected = + ["type M"; "type Point"; + "member get_Zero(unitVar0) = {x = 0; y = 0} @ (6,25--6,37)"; + "member get_Sign(p) (unitVar1) = Operators.Sign (fun arg0_0 -> Operators.Sign (arg0_0),p.x) @ (7,20--7,28)"; + "member op_Addition(p1,p2) = {x = Operators.op_Addition (fun arg0_0 -> fun arg1_0 -> LanguagePrimitives.AdditionDynamic (arg0_0,arg1_0),p1.x,p2.x); y = Operators.op_Addition (fun arg0_0 -> fun arg1_0 -> LanguagePrimitives.AdditionDynamic (arg0_0,arg1_0),p1.y,p2.y)} @ (9,33--9,68)"; + "let p1 = {x = 1; y = 10} @ (11,9--11,20)"; + "let p2 = {x = 2; y = 20} @ (12,9--12,20)"; + "let s = ListModule.Sum (fun arg0_0 -> Point.get_Zero (arg0_0),fun arg0_0 -> fun arg1_0 -> Point.op_Addition (arg0_0,arg1_0),Cons(M.p1 (),Cons(M.p2 (),Empty()))) @ (13,8--13,25)"; + "let s2 = Operators.Sign (fun arg0_0 -> arg0_0.get_Sign(()),M.p1 ()) @ (14,9--14,16)"] + + let actual = + printDeclarations None (List.ofSeq file1.Declarations) + |> Seq.toList + printfn "actual:\n\n%A" actual + actual + |> shouldPairwiseEqual expected + +[] +let ``Test ProjectForWitnesses3 GetWitnessPassingInfo`` () = + let cleanup, options = ProjectForWitnesses3.createOptions() + use _holder = cleanup + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + + for e in wholeProjectResults.Errors do + printfn "ProjectForWitnesses3 error: <<<%s>>>" e.Message + + begin + let symbol = + wholeProjectResults.GetAllUsesOfAllSymbols() + |> Array.tryFind (fun su -> su.Symbol.DisplayName = "sum") + |> Option.orElseWith (fun _ -> failwith "Could not get symbol") + |> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue) + |> Option.get + printfn "symbol = %s" symbol.FullName + let wpi = (symbol.GetWitnessPassingInfo()) + match wpi with + | None -> failwith "witness passing info expected" + | Some (nm, argTypes) -> + nm |> shouldEqual "Sum$W" + argTypes.Count |> shouldEqual 2 + let argName1 = argTypes.[0].Name + let argText1 = argTypes.[0].Type.ToString() + let argName2 = argTypes.[1].Name + let argText2 = argTypes.[1].Type.ToString() + argName1 |> shouldEqual (Some "get_Zero") + argText1 |> shouldEqual "type Microsoft.FSharp.Core.unit -> ^T" + argName2 |> shouldEqual (Some "op_Addition") + argText2 |> shouldEqual "type ^T -> ^T -> ^T" + end