Merge upstream FreeTDS changes

This merges everything from upstream while leaving the runtime lock
change in place.

This is mostly minor configuration changes and improvements to Ctlib.

freetds/appveyor.yml

@@ -7,6 +7,7 @@ services:
 environment:
   global:
     PACKAGE: freetds
+    CYG_PKGS: mingw64-x86_64-freetds
     FORK_USER: ocaml
     FORK_BRANCH: master
     CYG_ROOT: C:\cygwin64
@@ -22,7 +23,6 @@ environment:
 
 install:
   - ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1"))
-  - "%CYG_ROOT%\\setup-x86_64.exe -qnNdO -R %CYG_ROOT% -s http://cygwin.mirror.constant.com -l %CYG_ROOT%/var/cache/setup -P mingw64-x86_64-freetds"
 
 build_script:
   - call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh

freetds/config/discover.ml

@@ -6,16 +6,19 @@ let conf c =
   let libs = ["-lct"; "-lsybdb"] in
   let reg_row =
     let open C.C_define in
-    (* FIXME: "-" hack for a negative value.
-       See https://github.com/ocaml/dune/pull/1334 *)
-    let h = import c ~includes:["sybdb.h"] [("-REG_ROW", Type.Int)] in
-    match List.assoc "-REG_ROW" h with
-    | Value.Int r -> -r
+    let h = import c ~includes:["sybdb.h"] [("REG_ROW", Type.Int)] in
+    match List.assoc "REG_ROW" h with
+    | Value.Int r -> r
     | Value.Switch _ | Value.String _ -> assert false
     | exception _ ->
        C.die "The value of REG_ROW was not found in the C hreader file. \
               Please make sure the development files of FreeTDS are \
               installed in a location where the C compiler finds them." in
+  let ocaml_ver = C.ocaml_config_var_exn c "version" in
+  let major, minor = Scanf.sscanf ocaml_ver "%d.%d" (fun m n -> m, n) in
+  let cflags = if major > 4 || (major = 4 && minor >= 6) then
+                 "-DOCAML406" :: cflags
+                 else cflags in
   let fh = open_out "reg_row.txt" in
   fprintf fh "%d" reg_row;
   close_out fh;

freetds/freetds.opam

@@ -19,7 +19,7 @@ build: [
   ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 depends: [
-  "dune" {build}
+  "dune" {build & >= "1.4.0"}
   "cppo" {build}
   "ounit" {with-test & >= "2.0.0"}
   "ocaml" {>= "4.02.3"}

freetds/src/ct.ml

@@ -18,7 +18,8 @@
 *)
 
 (** A wrapper on the FreeTDS library for accessing Sybase and
-   Microsoft database providers. *)
+    Microsoft database providers. *)
+open Printf
 
 (* This is the catch-all exception that client code should trap *)
 exception End_results
@@ -44,6 +45,15 @@ type cmd_type = [ `Lang | `Rpc ]
 type cmd_option = [ `Recompile | `NoRecompile ]
 
 type result_type = [ `Row | `Param | `Status | `Cmd_done | `Cmd_succeed | `Cmd_fail ]
+
+let string_of_result_type : result_type -> string = function
+  | `Row -> "Row"
+  | `Param -> "Param"
+  | `Status -> "Status"
+  | `Cmd_done -> "Cmd_done"
+  | `Cmd_succeed -> "Cmd_succeed"
+  | `Cmd_fail -> "Cmd_fail"
+
 type resinfo_type = [ `Row_count | `Cmd_number | `Numdata ]
 
 (* type datetime = {
@@ -92,6 +102,19 @@ type sql_t =
         | `Null
         ]
 
+let string_of_sql_t : sql_t -> string = function
+  | `Bit b -> if b then "Bit(1)" else "Bit(0)"
+  | `Tinyint i -> sprintf "Tinyint(%i)" i
+  | `Smallint i -> sprintf "Smallint(%i)" i
+  | `Int i -> sprintf "Int(%li)" i
+  | `Text s -> sprintf "Text(%S)" s
+  | `String s -> sprintf "String(%S)" s
+  | `Binary s -> sprintf "Binary(%S)" s
+  | `Float f -> sprintf "Float(%g)" f
+  | `Datetime s -> sprintf "Datetime(%s)" s
+  | `Decimal s -> sprintf "Decimal(%s)" s
+  | `Null -> "Null"
+
 let _ =
     List.iter (fun (x,y) -> Callback.register_exception x y)
         [

freetds/src/ct.mli

@@ -66,6 +66,8 @@ type sql_t =
 | `Null
 ]
 
+val string_of_sql_t : sql_t -> string
+
 (** {4 Context} *)
 external ctx_create : unit -> context = "mltds_cs_ctx_create"
 
@@ -116,6 +118,8 @@ external send : command -> unit = "mltds_ct_send"
 type result_type =
         [ `Cmd_done | `Cmd_fail | `Cmd_succeed | `Param | `Row | `Status ]
 
+val string_of_result_type : result_type -> string
+
 external results : command -> result_type = "mltds_ct_results"
 
 type resinfo_type = [ `Cmd_number | `Numdata | `Row_count ]