More convenience functions

At the expense of short int somehow
mlt · Mar 30, 2013 · efaf933 · efaf933
1 parent 47ec85a
commit efaf933
Show file tree

Hide file tree

Showing 4 changed files with 152 additions and 42 deletions.
diff --git a/src/extensions.xslt b/src/extensions.xslt
@@ -5,8 +5,10 @@ TODO: Generate this XSLT from sql.xml to avoid hardcoding
 For this we need XSLT 2 that is not supported by xsltproc
  -->
 
-<xsl:stylesheet version="1.0"
-		xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+		xmlns:exsl="http://exslt.org/common"
+                extension-element-prefixes="exsl"
+		version="1.0">
   <xsl:output method="text" />
 
   <xsl:template match="/types"><xsl:text>! DO NOT EDIT! Generated file.
@@ -48,6 +50,10 @@ module fodbc_ext
 
   <xsl:call-template name="decl">
     <xsl:with-param name="fun" select="'SQLBindParameter'" />
+    <xsl:with-param name="extra">
+	<item>_</item>
+	<item>__</item>
+    </xsl:with-param>
   </xsl:call-template>
 
   <xsl:text>&#xa;contains&#xa;</xsl:text>
@@ -63,13 +69,22 @@ end module fodbc_ext
 
   <xsl:template name="decl">
     <xsl:param name="fun" />
+    <xsl:param name="extra" />
     <xsl:text>  interface </xsl:text>
     <xsl:value-of select="$fun" />
     <xsl:text>&#xa;</xsl:text>
     <xsl:for-each select="type">
+      <xsl:variable name="sql" select="@sql" />
       <xsl:text>     module procedure </xsl:text>
       <xsl:value-of select="$fun" />_<xsl:value-of select="@sql" />
       <xsl:text>&#xa;</xsl:text>
+      <xsl:if test="$extra">
+	<xsl:for-each select="exsl:node-set($extra)/item">
+	  <xsl:text>     module procedure </xsl:text>
+	  <xsl:value-of select="$fun" />_<xsl:value-of select="concat($sql, .)" />
+	  <xsl:text>&#xa;</xsl:text>
+	</xsl:for-each>
+      </xsl:if>
     </xsl:for-each>
     <xsl:text>     procedure </xsl:text>
     <xsl:value-of select="$fun" />
@@ -121,6 +136,29 @@ end module fodbc_ext
     ret = SQLBindParameter0(hstmt,ipar,fParamType,<xsl:value-of select="@sql" />,fSqlType, &amp;
     cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
   end function SQLBindParameter_<xsl:value-of select="@sql" />
+
+  function SQLBindParameter_<xsl:value-of select="@sql" />_ &amp;
+    (hstmt,ipar,fParamType,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_short),intent(in),value :: fParamType
+    <xsl:value-of select="@fortran" />,target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,fParamType,<xsl:value-of select="@sql" />, &amp;
+    <xsl:value-of select="@sql" />, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_<xsl:value-of select="@sql" />_
+
+  function SQLBindParameter_<xsl:value-of select="@sql" />__ &amp;
+    (hstmt,ipar,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    <xsl:value-of select="@fortran" />,target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,SQL_PARAM_INPUT,<xsl:value-of select="@sql" />, &amp;
+    <xsl:value-of select="@sql" />, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_<xsl:value-of select="@sql" />__
   </xsl:template>
 
 </xsl:stylesheet>
diff --git a/src/fodbc_ext.f03 b/src/fodbc_ext.f03
@@ -22,7 +22,6 @@ module fodbc_ext
   implicit none
 
   interface SQLBindCol
-     module procedure SQLBindCol_SQL_SMALLINT
      module procedure SQLBindCol_SQL_INTEGER
      module procedure SQLBindCol_SQL_REAL
      module procedure SQLBindCol_SQL_DOUBLE
@@ -31,7 +30,6 @@ module fodbc_ext
   end interface SQLBindCol
 
   interface SQLGetData
-     module procedure SQLGetData_SQL_SMALLINT
      module procedure SQLGetData_SQL_INTEGER
      module procedure SQLGetData_SQL_REAL
      module procedure SQLGetData_SQL_DOUBLE
@@ -40,53 +38,23 @@ module fodbc_ext
   end interface SQLGetData
 
   interface SQLBindParameter
-     module procedure SQLBindParameter_SQL_SMALLINT
      module procedure SQLBindParameter_SQL_INTEGER
+     module procedure SQLBindParameter_SQL_INTEGER_
+     module procedure SQLBindParameter_SQL_INTEGER__
      module procedure SQLBindParameter_SQL_REAL
+     module procedure SQLBindParameter_SQL_REAL_
+     module procedure SQLBindParameter_SQL_REAL__
      module procedure SQLBindParameter_SQL_DOUBLE
+     module procedure SQLBindParameter_SQL_DOUBLE_
+     module procedure SQLBindParameter_SQL_DOUBLE__
      module procedure SQLBindParameter_SQL_TYPE_TIMESTAMP
+     module procedure SQLBindParameter_SQL_TYPE_TIMESTAMP_
+     module procedure SQLBindParameter_SQL_TYPE_TIMESTAMP__
      procedure SQLBindParameter0
   end interface SQLBindParameter
 
 contains
 
-  function SQLBindCol_SQL_SMALLINT &
-       (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
-    integer(kind=c_short) :: ret
-    type(c_ptr),intent(in),value :: StatementHandle
-    integer(kind=c_short),intent(in),value :: ColumnNumber
-    integer(kind=c_short),target :: TargetValue
-    integer(kind=c_long),intent(out),optional :: StrLen_or_Ind
-    ret = SQLBindCol0(StatementHandle,ColumnNumber,SQL_SMALLINT, &
-        c_loc(TargetValue),sizeof(TargetValue), StrLen_or_Ind)
-  end function SQLBindCol_SQL_SMALLINT
-
-  function SQLGetData_SQL_SMALLINT &
-        (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
-    integer(kind=c_short) :: ret
-    type(c_ptr),intent(in),value :: StatementHandle
-    integer(kind=c_short),intent(in),value :: ColumnNumber
-    integer(kind=c_short),target :: TargetValue
-    integer(kind=c_long),intent(out),optional :: StrLen_or_Ind
-    ret = SQLGetData0(StatementHandle,ColumnNumber,SQL_SMALLINT, &
-        c_loc(TargetValue),sizeof(TargetValue),StrLen_or_Ind)
-  end function SQLGetData_SQL_SMALLINT
-
-  function SQLBindParameter_SQL_SMALLINT &
-    (hstmt,ipar,fParamType,fSqlType, &
-    cbColDef,ibScale,rgbValue,pcbValue) result(ret)
-    integer(kind=c_short) :: ret
-    type(c_ptr),intent(in),value :: hstmt
-    integer(kind=c_short),intent(in),value :: ipar
-    integer(kind=c_short),intent(in),value :: fParamType
-    integer(kind=c_short),intent(in),value :: fSqlType
-    integer(kind=c_long),intent(in),value :: cbColDef
-    integer(kind=c_short),intent(in),value :: ibScale
-    integer(kind=c_short),target :: rgbValue
-    integer(kind=c_long),intent(out),optional :: pcbValue
-    ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_SMALLINT,fSqlType, &
-    cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
-  end function SQLBindParameter_SQL_SMALLINT
   function SQLBindCol_SQL_INTEGER &
        (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
     integer(kind=c_short) :: ret
@@ -124,6 +92,30 @@ function SQLBindParameter_SQL_INTEGER &
     ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_INTEGER,fSqlType, &
     cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
   end function SQLBindParameter_SQL_INTEGER
+
+  function SQLBindParameter_SQL_INTEGER_ &
+    (hstmt,ipar,fParamType,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_short),intent(in),value :: fParamType
+    integer(kind=c_int),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_INTEGER, &
+    SQL_INTEGER, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_INTEGER_
+
+  function SQLBindParameter_SQL_INTEGER__ &
+    (hstmt,ipar,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_int),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,SQL_PARAM_INPUT,SQL_INTEGER, &
+    SQL_INTEGER, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_INTEGER__
+
   function SQLBindCol_SQL_REAL &
        (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
     integer(kind=c_short) :: ret
@@ -161,6 +153,30 @@ function SQLBindParameter_SQL_REAL &
     ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_REAL,fSqlType, &
     cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
   end function SQLBindParameter_SQL_REAL
+
+  function SQLBindParameter_SQL_REAL_ &
+    (hstmt,ipar,fParamType,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_short),intent(in),value :: fParamType
+    real(kind=c_float),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_REAL, &
+    SQL_REAL, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_REAL_
+
+  function SQLBindParameter_SQL_REAL__ &
+    (hstmt,ipar,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    real(kind=c_float),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,SQL_PARAM_INPUT,SQL_REAL, &
+    SQL_REAL, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_REAL__
+
   function SQLBindCol_SQL_DOUBLE &
        (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
     integer(kind=c_short) :: ret
@@ -198,6 +214,30 @@ function SQLBindParameter_SQL_DOUBLE &
     ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_DOUBLE,fSqlType, &
     cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
   end function SQLBindParameter_SQL_DOUBLE
+
+  function SQLBindParameter_SQL_DOUBLE_ &
+    (hstmt,ipar,fParamType,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_short),intent(in),value :: fParamType
+    real(kind=c_double),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_DOUBLE, &
+    SQL_DOUBLE, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_DOUBLE_
+
+  function SQLBindParameter_SQL_DOUBLE__ &
+    (hstmt,ipar,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    real(kind=c_double),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,SQL_PARAM_INPUT,SQL_DOUBLE, &
+    SQL_DOUBLE, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_DOUBLE__
+
   function SQLBindCol_SQL_TYPE_TIMESTAMP &
        (StatementHandle,ColumnNumber,TargetValue,StrLen_or_Ind) result(ret)
     integer(kind=c_short) :: ret
@@ -236,5 +276,29 @@ function SQLBindParameter_SQL_TYPE_TIMESTAMP &
     cbColDef,ibScale,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
   end function SQLBindParameter_SQL_TYPE_TIMESTAMP
 
+  function SQLBindParameter_SQL_TYPE_TIMESTAMP_ &
+    (hstmt,ipar,fParamType,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    integer(kind=c_short),intent(in),value :: fParamType
+    type(SQL_TIMESTAMP_STRUCT),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,fParamType,SQL_TYPE_TIMESTAMP, &
+    SQL_TYPE_TIMESTAMP, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_TYPE_TIMESTAMP_
+
+  function SQLBindParameter_SQL_TYPE_TIMESTAMP__ &
+    (hstmt,ipar,rgbValue,pcbValue) result(ret)
+    integer(kind=c_short) :: ret
+    type(c_ptr),intent(in),value :: hstmt
+    integer(kind=c_short),intent(in),value :: ipar
+    type(SQL_TIMESTAMP_STRUCT),target :: rgbValue
+    integer(kind=c_long),intent(out),optional :: pcbValue
+    ret = SQLBindParameter0(hstmt,ipar,SQL_PARAM_INPUT,SQL_TYPE_TIMESTAMP, &
+    SQL_TYPE_TIMESTAMP, 0, 0_2,c_loc(rgbValue),sizeof(rgbValue),pcbValue)
+  end function SQLBindParameter_SQL_TYPE_TIMESTAMP__
+
+
 end module fodbc_ext
 
diff --git a/src/fodbc_types.f03 b/src/fodbc_types.f03
@@ -26,6 +26,12 @@ module fodbc_types
   integer(kind=c_short),parameter :: SQL_HANDLE_STMT = 3
   integer(kind=c_short),parameter :: SQL_HANDLE_DESC = 4
 
+  type(c_ptr),parameter :: SQL_NULL_HENV = C_NULL_PTR
+  type(c_ptr),parameter :: SQL_NULL_HDBC = C_NULL_PTR
+  type(c_ptr),parameter :: SQL_NULL_HSTMT = C_NULL_PTR
+  type(c_ptr),parameter :: SQL_NULL_HANDLE = C_NULL_PTR
+  integer(c_short),parameter :: SQL_MAX_MESSAGE_LENGTH = 512
+
   ! /* SQL data type codes */
   integer(kind=c_short),parameter :: SQL_UNKNOWN_TYPE = 0
   integer(kind=c_short),parameter :: SQL_CHAR = 1

diff --git a/src/types.xml b/src/types.xml
@@ -1,6 +1,8 @@
 <?xml version="1.0"?>
 <types>
+  <!-- FIXME: The following somehow causes problems
   <type sql="SQL_SMALLINT" fortran="integer(kind=c_short)" />
+  -->
   <type sql="SQL_INTEGER" fortran="integer(kind=c_int)" />
   <type sql="SQL_REAL" fortran="real(kind=c_float)" />
   <type sql="SQL_DOUBLE" fortran="real(kind=c_double)" />