From f46558cf5606740084b0c1c957135d0bca78f38d Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 4 Feb 2015 15:40:58 -0800 Subject: [PATCH] Fix name-mangling of provided types fixes #102 closes #203 commit 6cc322727c1b7d0ae6a0034c2b9018e64d038794 Author: Steffen Forkmann Date: Tue Feb 3 15:30:23 2015 +0100 Do not generate logical type names like "MyNamespace.Test," commit b40d937a383c1715c3f052d9674d3bd4f89333a6 Author: Steffen Forkmann Date: Sun Jan 25 15:08:36 2015 +0100 Fix demangling of provided types with only default values - fixes #98 commit 515501a9765ab617e2837d7ce36ba06a3cbda1cd Author: Steffen Forkmann Date: Sun Jan 25 14:56:45 2015 +0100 Create test case for #98 commit 55695804d6af78a10ce9543764fec0656687156b Author: Steffen Forkmann Date: Sun Jan 25 14:50:04 2015 +0100 Added some tests to describe current behaviour of NameMangling of provided types commit be2d1570f925d52f1992324553db1f67f7544057 Author: Steffen Forkmann Date: Sun Jan 25 14:22:49 2015 +0100 Extract computeMangledNameWithoutDefaultArgValues to make it testable commit bbdd2a30fd2637c709eb94ce0e064521341bc9f9 Author: Steffen Forkmann Date: Sun Jan 25 13:13:00 2015 +0100 Cleanup: removed commented code which uses deleted functions --- .../FSharp.Compiler.Unittests.fsproj | 3 +- .../ManglingNameOfProvidedTypes.fs | 68 +++++++++++++++++++ src/fsharp/PrettyNaming.fs | 39 +++++++---- src/fsharp/est.fs | 11 +-- 4 files changed, 96 insertions(+), 25 deletions(-) create mode 100644 src/fsharp/FSharp.Compiler.Unittests/ManglingNameOfProvidedTypes.fs diff --git a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj index 280b96aba..5a38e3aa8 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj +++ b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj @@ -1,4 +1,4 @@ - + @@ -60,6 +60,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.Unittests/ManglingNameOfProvidedTypes.fs b/src/fsharp/FSharp.Compiler.Unittests/ManglingNameOfProvidedTypes.fs new file mode 100644 index 000000000..0180e6abd --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Unittests/ManglingNameOfProvidedTypes.fs @@ -0,0 +1,68 @@ +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +namespace FSharp.Compiler.Unittests + +open System +open System.Text +open NUnit.Framework +open Microsoft.FSharp.Compiler + +[] +type ManglingNamesOfProvidedTypesWithSingleParameter() = + + [] + member this.MangleWithNonDefaultValue() = + let mangled = + PrettyNaming.computeMangledNameWithoutDefaultArgValues("MyNamespace.Test", [| "xyz" |], [| "Foo", Some "abc" |]) + Assert.AreEqual("MyNamespace.Test,Foo=\"xyz\"", mangled) + + [] + member this.MangleWithDefaultValue() = + let mangled = + PrettyNaming.computeMangledNameWithoutDefaultArgValues("MyNamespace.Test", [| "xyz" |], [| "Foo", Some "xyz" |]) + Assert.AreEqual("MyNamespace.Test", mangled) + + [] + member this.DemangleNonDefaultValue() = + let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test,Foo=\"xyz\"" + Assert.AreEqual("MyNamespace.Test", name) + Assert.AreEqual([| "Foo", "xyz" |], parameters) + + [] + member this.DemangleDefaultValue() = + let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test," + Assert.AreEqual("MyNamespace.Test", name) + Assert.AreEqual([||], parameters) + + [] + member this.DemangleNewDefaultValue() = + let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test" + Assert.AreEqual("MyNamespace.Test", name) + Assert.AreEqual([||], parameters) + +[] +type ManglingNamesOfProvidedTypesWithMultipleParameter() = + + [] + member this.MangleWithNonDefaultValue() = + let mangled = + PrettyNaming.computeMangledNameWithoutDefaultArgValues + ("MyNamespace.Test", [| "xyz"; "abc" |], + [| "Foo", Some "foo" + "Foo2", Some "foo2" |]) + Assert.AreEqual("MyNamespace.Test,Foo=\"xyz\",Foo2=\"abc\"", mangled) + + [] + member this.MangleWithDefaultValue() = + let mangled = + PrettyNaming.computeMangledNameWithoutDefaultArgValues + ("MyNamespace.Test", [| "xyz"; "abc" |], + [| "Foo", Some "xyz" + "Foo2", Some "abc" |]) + Assert.AreEqual("MyNamespace.Test", mangled) + + [] + member this.DemangleMultiParameter() = + let name, parameters = PrettyNaming.demangleProvidedTypeName "TestType,Foo=\"xyz\",Foo2=\"abc\"" + Assert.AreEqual("TestType", name) + Assert.AreEqual([| "Foo", "xyz" + "Foo2", "abc" |], parameters) \ No newline at end of file diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 9b74deacf..84e384809 100644 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -445,16 +445,15 @@ module internal Microsoft.FSharp.Compiler.PrettyNaming let demangleProvidedTypeName (typeLogicalName:string) = if typeLogicalName.Contains "," then - let pieces = splitAroundQuotation typeLogicalName ',' - if pieces.[1..] |> Array.forall (fun x -> tryDemangleStaticStringArg x |> Option.isSome) then - let argNamesAndValues = - pieces.[1..] |> Array.map (fun piece -> - match tryDemangleStaticStringArg piece with - | None -> raise (InvalidMangledStaticArg piece) - | Some v -> v) - pieces.[0], argNamesAndValues - else - typeLogicalName, [| |] + let pieces = splitAroundQuotation typeLogicalName ',' + match pieces with + | [| x; "" |] -> x, [| |] + | _ -> + let argNamesAndValues = pieces.[1..] |> Array.choose tryDemangleStaticStringArg + if argNamesAndValues.Length = (pieces.Length - 1) then + pieces.[0], argNamesAndValues + else + typeLogicalName, [| |] else typeLogicalName, [| |] @@ -463,8 +462,20 @@ module internal Microsoft.FSharp.Compiler.PrettyNaming nonDefaultArgs |> Array.map mangleStaticStringArg |> String.concat "," - typeLogicalName+","+nonDefaultArgsText - //let testDemangleStaticStringArg() = - // for x in [ ""; "\""; "\"\""; "a"; "\\"; "\\\\"; "\\\""; "_"; "\"\"" ] do - // if demangleStaticStringArg (mangleStaticStringArg x) <> x then printfn "failed for <<%s>>" x + if nonDefaultArgsText = "" then + typeLogicalName + else + typeLogicalName + "," + nonDefaultArgsText + + + let computeMangledNameWithoutDefaultArgValues(nm,staticArgs,defaultArgValues) = + let nonDefaultArgs = + (staticArgs,defaultArgValues) + ||> Array.zip + |> Array.choose (fun (staticArg, (defaultArgName, defaultArgValue)) -> + let actualArgValue = string staticArg + match defaultArgValue with + | Some v when v = actualArgValue -> None + | _ -> Some (defaultArgName, actualArgValue)) + mangleProvidedTypeName (nm, nonDefaultArgs) \ No newline at end of file diff --git a/src/fsharp/est.fs b/src/fsharp/est.fs index 31c2198b7..59e513ebc 100644 --- a/src/fsharp/est.fs +++ b/src/fsharp/est.fs @@ -1262,16 +1262,7 @@ module internal ExtensionTyping = staticParams.PApply((fun ps -> ps |> Array.map (fun sp -> sp.Name, (if sp.IsOptional then Some (string sp.RawDefaultValue) else None ))),range=m) let defaultArgValues = defaultArgValues.PUntaint(id,m) - - let nonDefaultArgs = - (staticArgs,defaultArgValues) - ||> Array.zip - |> Array.choose (fun (staticArg, (defaultArgName, defaultArgValue)) -> - let actualArgValue = string staticArg - match defaultArgValue with - | Some v when v = actualArgValue -> None - | _ -> Some (defaultArgName, actualArgValue)) - PrettyNaming.mangleProvidedTypeName (nm, nonDefaultArgs) + PrettyNaming.computeMangledNameWithoutDefaultArgValues(nm,staticArgs,defaultArgValues) /// Apply the given provided method to the given static arguments (the arguments are assumed to have been sorted into application order) let TryApplyProvidedMethod(methBeforeArgs:Tainted, staticArgs:obj[], m:range) = -- GitLab