提交 f46558cf 编写于 作者: S Steffen Forkmann 提交者: latkin

Fix name-mangling of provided types

fixes #102
closes #203

commit 6cc322727c1b7d0ae6a0034c2b9018e64d038794
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Tue Feb 3 15:30:23 2015 +0100

    Do not generate logical type names like "MyNamespace.Test,"

commit b40d937a383c1715c3f052d9674d3bd4f89333a6
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
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 <steffen.forkmann@msu-solutions.de>
Date:   Sun Jan 25 14:56:45 2015 +0100

    Create test case for #98

commit 55695804d6af78a10ce9543764fec0656687156b
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
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 <steffen.forkmann@msu-solutions.de>
Date:   Sun Jan 25 14:22:49 2015 +0100

    Extract computeMangledNameWithoutDefaultArgValues to make it testable

commit bbdd2a30fd2637c709eb94ce0e064521341bc9f9
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Sun Jan 25 13:13:00 2015 +0100

    Cleanup: removed commented code which uses deleted functions
上级 c9d7c43f
<?xml version="1.0" encoding="utf-8"?>
<?xml version="1.0" encoding="utf-8"?>
<!-- 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. -->
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
......@@ -60,6 +60,7 @@
</ItemGroup>
<ItemGroup>
<Compile Include="NUnitFrameworkShims.fs" Condition="'$(TargetFramework)' == 'sl3-wp'" />
<Compile Include="ManglingNameOfProvidedTypes.fs" />
<Compile Include="HashIfExpression.fs" />
</ItemGroup>
<ItemGroup>
......
// 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
[<TestFixture>]
type ManglingNamesOfProvidedTypesWithSingleParameter() =
[<Test>]
member this.MangleWithNonDefaultValue() =
let mangled =
PrettyNaming.computeMangledNameWithoutDefaultArgValues("MyNamespace.Test", [| "xyz" |], [| "Foo", Some "abc" |])
Assert.AreEqual("MyNamespace.Test,Foo=\"xyz\"", mangled)
[<Test>]
member this.MangleWithDefaultValue() =
let mangled =
PrettyNaming.computeMangledNameWithoutDefaultArgValues("MyNamespace.Test", [| "xyz" |], [| "Foo", Some "xyz" |])
Assert.AreEqual("MyNamespace.Test", mangled)
[<Test>]
member this.DemangleNonDefaultValue() =
let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test,Foo=\"xyz\""
Assert.AreEqual("MyNamespace.Test", name)
Assert.AreEqual([| "Foo", "xyz" |], parameters)
[<Test>]
member this.DemangleDefaultValue() =
let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test,"
Assert.AreEqual("MyNamespace.Test", name)
Assert.AreEqual([||], parameters)
[<Test>]
member this.DemangleNewDefaultValue() =
let name, parameters = PrettyNaming.demangleProvidedTypeName "MyNamespace.Test"
Assert.AreEqual("MyNamespace.Test", name)
Assert.AreEqual([||], parameters)
[<TestFixture>]
type ManglingNamesOfProvidedTypesWithMultipleParameter() =
[<Test>]
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)
[<Test>]
member this.MangleWithDefaultValue() =
let mangled =
PrettyNaming.computeMangledNameWithoutDefaultArgValues
("MyNamespace.Test", [| "xyz"; "abc" |],
[| "Foo", Some "xyz"
"Foo2", Some "abc" |])
Assert.AreEqual("MyNamespace.Test", mangled)
[<Test>]
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
......@@ -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
......@@ -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<ProvidedMethodBase>, staticArgs:obj[], m:range) =
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册