diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 4311ad55b6c..6c25a422685 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3013,6 +3013,11 @@ let superOfTycon (g: TcGlobals) (tycon: Tycon) = | None -> g.obj_ty | Some ty -> ty +/// walk a TyconRef's inheritance tree, yielding any parent types as an array +let supersOfTyconRef (tcref: TyconRef) = + Array.unfold (fun (tcref: TyconRef) -> match tcref.TypeContents.tcaug_super with Some (TType_app(sup, _)) -> Some(sup, sup) | _ -> None) tcref + + //---------------------------------------------------------------------------- // Detect attributes //---------------------------------------------------------------------------- @@ -3119,12 +3124,16 @@ let TryFindTyconRefBoolAttribute g m attribSpec tcref = | ([ Some ((:? bool as v) : obj) ], _) -> Some v | _ -> None) +/// Try to find the resolved attributeusage for an type by walking its inheritance tree and picking the correct attribute usage value let TryFindAttributeUsageAttribute g m tcref = - TryBindTyconRefAttribute g m g.attrib_AttributeUsageAttribute tcref + [| yield tcref + yield! supersOfTyconRef tcref |] + |> Array.tryPick (fun tcref -> + TryBindTyconRefAttribute g m g.attrib_AttributeUsageAttribute tcref (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", _, _, ILAttribElem.Bool res) -> Some res | _ -> None)) (fun (Attrib(_, _, _, named, _, _, _)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple", _, _, AttribBoolArg res ) -> Some res | _ -> None)) (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) - + ) /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 62254811bc5..08a1e44e639 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -43,6 +43,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/AttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/AttributeCheckingTests.fs new file mode 100644 index 00000000000..503ad0312bc --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/AttributeCheckingTests.fs @@ -0,0 +1,27 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.ComponentTests.AttributeChecking + +open Xunit +open FSharp.Test.Utilities.Compiler + +module AttributeCheckingTests = + + [] + let ``attributes check inherited AllowMultiple`` () = + Fsx """ +open System + +[] +type HttpMethodAttribute() = inherit Attribute() +type HttpGetAttribute() = inherit HttpMethodAttribute() + +[] // this shouldn't error like +[] // this doesn't +type C() = + member _.M() = () + """ + |> ignoreWarnings + |> compile + |> shouldSucceed + \ No newline at end of file