Merge pull request #387 from Jand42/master

types and arrays in F# attribute contructor arguments

Author: dsyme

src/fsharp/infos.fs

@@ -2541,7 +2541,7 @@ let rec evalILAttribElem e =
     | ILAttribElem.TypeRef (Some _t) -> fail()
     | ILAttribElem.TypeRef None     -> null
 
-let evalFSharpAttribArg e = 
+let rec evalFSharpAttribArg g e = 
     match e with
     | Expr.Const(c,_,_) -> 
         match c with 
@@ -2560,8 +2560,9 @@ let evalFSharpAttribArg e =
         | Const.Zero -> null
         | Const.String s ->  box s
         | _ -> fail()
-    // TODO: typeof<..> in attribute values
-    // TODO: arrays in attribute values
+    | Expr.Op (TOp.Array,_,a,_) -> box [| for i in a -> evalFSharpAttribArg g i |]
+    | TypeOfExpr g ty -> box ty
+    // TODO: | TypeDefOfExpr g ty
     | _ -> fail()
 
 type AttribInfo = 
@@ -2590,7 +2591,7 @@ type AttribInfo =
              unnamedArgs
              |> List.map (fun (AttribExpr(origExpr,evaluatedExpr)) -> 
                     let ty = tyOfExpr g origExpr
-                    let obj = evalFSharpAttribArg evaluatedExpr
+                    let obj = evalFSharpAttribArg g evaluatedExpr
                     ty,obj) 
          | ILAttribInfo (g, amap, scoref, cattr, m) -> 
               let parms, _args = decodeILAttribData g.ilg cattr (Some scoref) 
@@ -2605,7 +2606,7 @@ type AttribInfo =
              namedArgs
              |> List.map (fun (AttribNamedArg(nm,_,isField,AttribExpr(origExpr,evaluatedExpr))) -> 
                     let ty = tyOfExpr g origExpr
-                    let obj = evalFSharpAttribArg evaluatedExpr
+                    let obj = evalFSharpAttribArg g evaluatedExpr
                     ty, nm, isField, obj) 
          | ILAttribInfo (g, amap, scoref, cattr, m) -> 
               let _parms, namedArgs = decodeILAttribData g.ilg cattr (Some scoref) 

src/fsharp/vs/Symbols.fs

@@ -1711,19 +1711,25 @@ and FSharpType(cenv, typ:TType) =
 
 and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = 
 
+    let rec resolveArgObj (arg: obj) =
+        match arg with
+        | :? TType as t -> box (FSharpType(cenv, t)) 
+        | :? (obj[]) as a -> a |> Array.map resolveArgObj |> box
+        | _ -> arg
+
     member __.AttributeType =  
         FSharpEntity(cenv,  attrib.TyconRef)
 
     member __.IsUnresolved = entityIsUnresolved(attrib.TyconRef)
 
     member __.ConstructorArguments = 
         attrib.ConstructorArguments 
-        |> List.map (fun (ty, obj) -> FSharpType(cenv, ty), obj)
+        |> List.map (fun (ty, obj) -> FSharpType(cenv, ty), resolveArgObj obj)
         |> makeReadOnlyCollection
 
     member __.NamedArguments = 
         attrib.NamedArguments 
-        |> List.map (fun (ty, nm, isField, obj) -> FSharpType(cenv, ty), nm, isField, obj)
+        |> List.map (fun (ty, nm, isField, obj) -> FSharpType(cenv, ty), nm, isField, resolveArgObj obj)
         |> makeReadOnlyCollection
 
     member __.Format(denv: FSharpDisplayContext) = 

tests/service/ProjectAnalysisTests.fs

@@ -4496,3 +4496,83 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.LiteralValue`` () =
 
     let notLit = project36Module.MembersFunctionsAndValues.[1]
     shouldEqual true notLit.LiteralValue.IsNone
+
+module Project37 = 
+    open System.IO
+
+    let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
+    let base2 = Path.GetTempFileName()
+    let dllName = Path.ChangeExtension(base2, ".dll")
+    let projFileName = Path.ChangeExtension(base2, ".fsproj")
+    let fileSource1 = """
+[<System.AttributeUsage(System.AttributeTargets.Method)>]
+type AttrTestAttribute() =
+    inherit System.Attribute()
+
+    new (t: System.Type) = AttrTestAttribute()
+    new (t: System.Type[]) = AttrTestAttribute()
+    new (t: int[]) = AttrTestAttribute()
+
+type TestUnion = | A of string
+type TestRecord = { B : int }
+
+module Test =
+    [<AttrTest(typeof<int>)>]
+    let withType = 0
+    [<AttrTest(typeof<list<int>>)>]
+    let withGenericType = 0
+    [<AttrTest(typeof<int * int>)>]
+    let withTupleType = 0
+    [<AttrTest(typeof<int -> int>)>]
+    let withFuncType = 0
+    [<AttrTest([| typeof<TestUnion>; typeof<TestRecord> |])>]
+    let withTypeArray = 0
+    [<AttrTest([| 0; 1; 2 |])>]
+    let withIntArray = 0
+"""
+    File.WriteAllText(fileName1, fileSource1)
+    let fileNames = [fileName1]
+    let args = mkProjectCommandLineArgs (dllName, fileNames)
+    let options =  checker.GetProjectOptionsFromCommandLineArgs (projFileName, args)
+    let wholeProjectResults =
+        checker.ParseAndCheckProject(options)
+        |> Async.RunSynchronously
+
+[<Test>]
+let ``Test project37 typeof and arrays in attribute constructor arguments`` () =
+    let allSymbolsUses = Project37.wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously
+    for su in allSymbolsUses do
+        match su.Symbol with
+        | :? FSharpMemberOrFunctionOrValue as funcSymbol ->
+            let getAttrArg() =
+                let arg = funcSymbol.Attributes.[0].ConstructorArguments.[0] |> snd      
+                arg :?> FSharpType 
+            match funcSymbol.DisplayName with
+            | "withType" ->
+                let t = getAttrArg()
+                t.TypeDefinition.DisplayName |> shouldEqual "int"
+            | "withGenericType" ->
+                let t = getAttrArg()
+                t.TypeDefinition.DisplayName |> shouldEqual "list"
+                t.GenericArguments.[0].TypeDefinition.DisplayName |> shouldEqual "int"
+            | "withTupleType" ->
+                let t = getAttrArg()
+                t.IsTupleType |> shouldEqual true
+                t.GenericArguments.[0].TypeDefinition.DisplayName |> shouldEqual "int"
+                t.GenericArguments.[1].TypeDefinition.DisplayName |> shouldEqual "int"
+            | "withFuncType" ->
+                let t = getAttrArg()
+                t.IsFunctionType |> shouldEqual true
+                t.GenericArguments.[0].TypeDefinition.DisplayName |> shouldEqual "int"
+                t.GenericArguments.[1].TypeDefinition.DisplayName |> shouldEqual "int"
+            | "withTypeArray" ->
+                let attr = funcSymbol.Attributes.[0].ConstructorArguments.[0] |> snd      
+                let ta = attr :?> obj[] |> Array.map (fun t -> t :?> FSharpType)
+                ta.[0].TypeDefinition.DisplayName |> shouldEqual "TestUnion"
+                ta.[1].TypeDefinition.DisplayName |> shouldEqual "TestRecord"
+            | "withIntArray" ->
+                let attr = funcSymbol.Attributes.[0].ConstructorArguments.[0] |> snd      
+                let a = attr :?> obj[] |> Array.map (fun t -> t :?> int)
+                a |> shouldEqual [| 0; 1; 2 |] 
+            | _ -> ()
+        | _ -> ()