Issue 199 (#212)

Author: dmitry-a-morozov

src/SqlClient.Tests/ProgrammabilityTests.fs

@@ -241,6 +241,34 @@ let ResultSetAndOutParam() =
     Assert.Equal<_ list>([ Some "donkey" ], [ for x in result -> x.myName ] )
     Assert.Equal(2L, !total)
 
+[<Fact>]
+let TVFSynonym() = 
+    let personId = 42
+    let actual = 
+        use cmd = new AdventureWorks.HumanResources.GetContactInformation()
+        cmd.ExecuteSingle(personId)
+        |> Option.map(fun x -> x.FirstName, x.LastName)
+
+    let expected = 
+        use cmd = new GetContactInformation()
+        cmd.ExecuteSingle(personId)
+        |> Option.map(fun x -> x.FirstName, x.LastName)
+
+    Assert.Equal(expected, actual)
+
+[<Fact>]
+let SPSynonym() = 
+    let personId = 42
+    let actual = 
+        use cmd = new AdventureWorks.HumanResources.GetEmployeeManagers()
+        [ for x in cmd.Execute(personId) -> sprintf "%A.%A" x.FirstName x.LastName ]
+
+    let expected = 
+        use cmd = new AdventureWorks.dbo.uspGetEmployeeManagers()
+        [ for x in cmd.Execute(personId) -> sprintf "%A.%A" x.FirstName x.LastName ]
+
+    Assert.Equal<_ list>(expected, actual)
+
 module ReturnValues = 
     type AdventureWorks = SqlProgrammabilityProvider<ConnectionStrings.AdventureWorksNamed, UseReturnValue = true>
 

src/SqlClient.Tests/extensions.sql

@@ -61,6 +61,13 @@ IF OBJECT_ID(N'dbo.TableHavingColumnNamesWithSpaces') IS NOT NULL
 	DROP TABLE dbo.TableHavingColumnNamesWithSpaces
 GO
 
+IF OBJECT_ID(N'HumanResources.GetContactInformation') IS NOT NULL
+	DROP SYNONYM HumanResources.GetContactInformation
+GO
+
+IF OBJECT_ID(N'HumanResources.GetEmployeeManagers') IS NOT NULL
+	DROP SYNONYM HumanResources.GetEmployeeManagers
+GO
 
 CREATE PROCEDURE dbo.AddRef @x AS INT, @y AS INT, @sum AS INT OUTPUT 
 AS
@@ -193,3 +200,9 @@ END
 
 GO
 
+CREATE SYNONYM HumanResources.GetContactInformation FOR dbo.ufnGetContactInformation;
+GO
+
+CREATE SYNONYM HumanResources.GetEmployeeManagers FOR dbo.uspGetEmployeeManagers;
+GO
+

src/SqlClient/SqlClientExtensions.fs

@@ -176,38 +176,28 @@ let rec parseDefaultValue (definition: string) (expr: Microsoft.SqlServer.Transa
         | _  -> None 
     | _ -> None 
 
-type Routine = 
-    | StoredProcedure of schema: string * name: string * definition: string * description: string option
-    | TableValuedFunction of schema: string * name: string * definition: string * description: string option
-    | ScalarValuedFunction of schema: string * name: string * definition: string * description: string option
-
-    member this.Definition = 
-        match this with
-        | StoredProcedure(_, _, definition, _) 
-        | TableValuedFunction(_, _, definition, _) 
-        | ScalarValuedFunction(_, _, definition, _) -> definition
-
-    member this.Description = 
-        match this with
-        | StoredProcedure(_, _, _, description) 
-        | TableValuedFunction(_, _, _, description) 
-        | ScalarValuedFunction(_, _, _, description) -> description
-
-    member this.TwoPartName = 
-        match this with
-        | StoredProcedure(schema, name, _, _) 
-        | TableValuedFunction(schema, name, _, _) 
-        | ScalarValuedFunction(schema, name, _, _) -> schema, name
-
-    member this.IsStoredProc = match this with StoredProcedure _ -> true | _ -> false
+type internal RoutineType = StoredProcedure | TableValuedFunction | ScalarValuedFunction
+
+type internal Routine = {
+    Type: RoutineType
+    Schema: string
+    Name: string
+    Definition: string
+    Description: string option
+    BaseObject: string * string
+}   with
+
+    member this.TwoPartName = this.Schema, this.Name
+
+    member this.IsStoredProc = this.Type = StoredProcedure 
 
     member this.ToCommantText(parameters: Parameter list) = 
         let twoPartNameIdentifier = sprintf "%s.%s" <|| this.TwoPartName
-        match this with 
-        | StoredProcedure _-> twoPartNameIdentifier
-        | TableValuedFunction _ -> 
+        match this.Type with 
+        | StoredProcedure -> twoPartNameIdentifier
+        | TableValuedFunction -> 
             parameters |> List.map (fun p -> p.Name) |> String.concat ", " |> sprintf "SELECT * FROM %s(%s)" twoPartNameIdentifier
-        | ScalarValuedFunction _ ->     
+        | ScalarValuedFunction ->     
             parameters |> List.map (fun p -> p.Name) |> String.concat ", " |> sprintf "SELECT %s(%s)" twoPartNameIdentifier
 
 let internal providerTypes = 
@@ -305,30 +295,82 @@ type SqlConnection with
             then 
                 "(SELECT NULL AS Value)"
             else 
-                "fn_listextendedproperty ('MS_Description', 'schema', SPECIFIC_SCHEMA, ROUTINE_TYPE, SPECIFIC_NAME, default, default)" 
-
-        let getRoutinesQuery = sprintf "
-            SELECT 
-                SPECIFIC_SCHEMA
-                ,SPECIFIC_NAME
-                ,DATA_TYPE
-                ,DEFINITION = ISNULL( OBJECT_DEFINITION( OBJECT_ID( SPECIFIC_SCHEMA + '.' + SPECIFIC_NAME)), '')  
-	            ,DESCRIPTION = XProp.Value
-            FROM 
-                INFORMATION_SCHEMA.ROUTINES 
-                OUTER APPLY %s AS XProp
-            WHERE 
-                ROUTINE_SCHEMA = '%s'" descriptionSelector schema
+                "fn_listextendedproperty ('MS_Description', 'schema', BaseObjectSchema, ROUTINE_TYPE, BaseObjectName, default, default)" 
+
+        let getRoutinesQuery = 
+            sprintf "
+                WITH ExplicitRoutines AS
+                (
+	                SELECT 
+		                SPECIFIC_SCHEMA AS [Schema]
+		                ,SPECIFIC_NAME AS Name
+		                ,ROUTINE_TYPE
+		                ,DATA_TYPE
+		                ,SPECIFIC_SCHEMA AS BaseObjectSchema
+		                ,SPECIFIC_NAME AS BaseObjectName
+	                FROM 
+		                INFORMATION_SCHEMA.ROUTINES 
+                ),
+                Synonyms AS
+                (
+	                SELECT 
+		                OBJECT_SCHEMA_NAME(object_id) AS [Schema]
+		                ,name AS Name
+		                ,ROUTINE_TYPE
+		                ,DATA_TYPE
+		                ,SPECIFIC_SCHEMA AS BaseObjectSchema
+		                ,SPECIFIC_NAME AS BaseObjectName
+	                FROM 
+		                sys.synonyms
+		                JOIN INFORMATION_SCHEMA.ROUTINES ON 
+			                OBJECT_ID(ROUTINES.ROUTINE_SCHEMA + '.' + ROUTINES.ROUTINE_NAME) = OBJECT_ID(base_object_name)
+                )
+                SELECT 
+	                XS.[Schema]
+	                ,XS.Name
+	                ,RoutineSubType = 
+		                CASE  
+			                WHEN XS.DATA_TYPE = 'TABLE' THEN 'TableValuedFunction'
+			                WHEN XS.DATA_TYPE IS NULL THEN 'StoredProcedure'
+			                ELSE 'ScalarValuedFunction'
+		                END
+	                ,ISNULL( OBJECT_DEFINITION( OBJECT_ID( XS.BaseObjectSchema + '.' + XS.BaseObjectName)), '') AS [Definition]
+	                ,XS.BaseObjectSchema
+	                ,XS.BaseObjectName
+	                ,[Description] = XProp.Value
+                FROM 
+	                (
+		                SELECT * FROM ExplicitRoutines
+		                UNION ALL
+		                SELECT * FROM Synonyms
+	                ) AS XS
+                    OUTER APPLY %s AS XProp
+                WHERE	
+	                [Schema] = @schema            
+            " descriptionSelector 
 
         use cmd = new SqlCommand(getRoutinesQuery, this)
+        cmd.Parameters.AddWithValue("@schema", schema) |> ignore
+
         cmd.ExecuteQuery(fun x ->
-            let schema, name = unbox x.["SPECIFIC_SCHEMA"], unbox x.["SPECIFIC_NAME"]
-            let definition = unbox x.["DEFINITION"]
-            let description = x.TryGetValue( "DESCRIPTION")
-            match x.["DATA_TYPE"] with
-            | :? string as x when x = "TABLE" -> TableValuedFunction(schema, name, definition, description)
-            | :? DBNull -> StoredProcedure(schema, name, definition, description)
-            | _ -> ScalarValuedFunction(schema, name, definition, description)
+            let schema, name = unbox x.["Schema"], unbox x.["Name"]
+            let definition = unbox x.["Definition"]
+            let description = x.TryGetValue( "Description")
+            let routineType =  
+                match string x.["RoutineSubType"] with
+                | "TableValuedFunction" -> TableValuedFunction
+                | "StoredProcedure" -> StoredProcedure
+                | "ScalarValuedFunction" -> ScalarValuedFunction
+                | unexpected -> failwithf "Unexpected database routine type: %s." unexpected
+
+            { 
+                Type = routineType 
+                Schema = schema
+                Name = name
+                Definition = definition
+                Description = description 
+                BaseObject = unbox x.["BaseObjectSchema"], unbox x.["BaseObjectName"]
+            }
         ) 
         |> Seq.toArray
 
@@ -377,7 +419,7 @@ type SqlConnection with
                 OUTER APPLY %s AS XProp
             WHERE
                 p.Name <> '' 
-                AND OBJECT_ID('%s.%s') = object_id" descriptionSelector <|| routine.TwoPartName
+                AND OBJECT_ID('%s.%s') = object_id" descriptionSelector <|| routine.BaseObject
 
         [
             use cmd = new SqlCommand( query, this)

src/SqlClient/SqlClientProvider.fs

@@ -167,7 +167,7 @@ type public SqlProgrammabilityProvider(config : TypeProviderConfig) as this =
 
                         let commandText = routine.ToCommantText(parameters)
                         let outputColumns = DesignTime.GetOutputColumns(conn, commandText, parameters, routine.IsStoredProc)
-                        let rank = match routine with ScalarValuedFunction _ -> ResultRank.ScalarValue | _ -> ResultRank.Sequence
+                        let rank = if routine.Type = ScalarValuedFunction then ResultRank.ScalarValue else ResultRank.Sequence
 
                         let hasOutputParameters = parameters |> List.exists (fun x -> x.Direction.HasFlag( ParameterDirection.Output))