Add send_describe_prepared and send_describe_portal and test.

Author: paurkedal

_oasis

@@ -44,6 +44,14 @@ Flag examples
   Description:    Build examples
   Default:        true
 
+Executable async
+  Path:           examples
+  MainIs:         async.ml
+  Build$:         flag(examples)
+  BuildDepends:   postgresql
+  Install:        false
+  CompiledObject: best
+
 Executable cursor
   Path:           examples
   MainIs:         cursor.ml

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 13a07b9ae83498d4d812e34d9fb75898)
+# DO NOT EDIT (digest: d32380a8a5d9af5342a2f383d8fb4575)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -27,6 +27,10 @@
 <lib/*.ml{,i}>: pkg_threads
 "lib/postgresql_stubs.c": pkg_bigarray
 "lib/postgresql_stubs.c": pkg_threads
+# Executable async
+<examples/async.{native,byte}>: pkg_bigarray
+<examples/async.{native,byte}>: pkg_threads
+<examples/async.{native,byte}>: use_postgresql
 # Executable cursor
 <examples/cursor.{native,byte}>: pkg_bigarray
 <examples/cursor.{native,byte}>: pkg_threads

examples/async.ml

@@ -0,0 +1,61 @@
+open Postgresql
+
+let _ =
+  if Array.length Sys.argv <> 2 then (
+    Printf.printf "\
+      Usage:  async conninfo\n\
+      Connect to PostgreSQL with [conninfo] (e.g. \"host=localhost\"),\n\
+      and run async tests on a temporary table\n";
+    exit 1)
+
+let wait_for_result c =
+  c#consume_input;
+  while c#is_busy do
+    ignore (Unix.select [Obj.magic c#socket] [] [] (-.1.0));
+    c#consume_input
+  done
+
+let fetch_result c = wait_for_result c; c#get_result
+
+let fetch_single_result c =
+  match fetch_result c with
+  | None -> assert false
+  | Some r -> assert (fetch_result c = None); r
+
+let main () =
+  let c = new connection ~conninfo:Sys.argv.(1) () in
+  c#set_nonblocking true;
+  c#send_query "\
+    CREATE TEMPORARY TABLE postgresql_ocaml_async \
+      (id SERIAL PRIMARY KEY, a INTEGER NOT NULL, b TEXT NOT NULL)";
+  assert ((fetch_single_result c)#status = Command_ok);
+  c#send_prepare "test_ins"
+                 "INSERT INTO postgresql_ocaml_async (a, b) VALUES ($1, $2)";
+  assert ((fetch_single_result c)#status = Command_ok);
+  c#send_query_prepared ~params:[|"2"; "two"|] "test_ins";
+  assert ((fetch_single_result c)#status = Command_ok);
+  c#send_query_prepared ~params:[|"3"; "three"|] "test_ins";
+  assert ((fetch_single_result c)#status = Command_ok);
+  c#send_prepare "test_sel" "SELECT * FROM postgresql_ocaml_async";
+  assert ((fetch_single_result c)#status = Command_ok);
+  c#send_describe_prepared "test_sel";
+  let r = fetch_single_result c in
+  assert (r#status = Command_ok);
+  assert (r#nfields = 3);
+  assert (r#fname 0 = "id");
+  assert (r#fname 1 = "a");
+  assert (r#fname 2 = "b");
+  c#send_query_prepared "test_sel";
+  let r = fetch_single_result c in
+  assert (r#status = Tuples_ok);
+  assert (r#ntuples = 2);
+  assert (r#nfields = 3);
+  for i = 0 to r#ntuples - 1 do
+    Printf.printf "%s %s %s\n"
+                  (r#getvalue i 0) (r#getvalue i 1) (r#getvalue i 2)
+  done
+
+let _ =
+  try main () with
+  | Error e -> prerr_endline (string_of_error e)
+  | e -> prerr_endline (Printexc.to_string e)

lib/postgresql.ml

@@ -400,6 +400,12 @@ module Stub = struct
     connection -> string -> string array -> bool array -> int
     = "PQsendQueryPrepared_stub"
 
+  external send_describe_prepared : connection -> string -> int
+    = "PQsendDescribePrepared_stub"
+
+  external send_describe_portal : connection -> string -> int
+    = "PQsendDescribePortal_stub"
+
   external get_result : connection -> result = "PQgetResult_stub"
   external consume_input : connection -> int = "PQconsumeInput_stub" "noalloc"
   external is_busy : connection -> bool = "PQisBusy_stub" "noalloc"
@@ -803,6 +809,16 @@ object (self)
       if Stub.send_query_prepared conn stm_name params binary_params <> 1 then
         signal_error conn)
 
+  method send_describe_prepared stm_name =
+    wrap_conn (fun conn ->
+      if Stub.send_describe_prepared conn stm_name <> 1 then
+        signal_error conn)
+
+  method send_describe_portal portal_name =
+    wrap_conn (fun conn ->
+      if Stub.send_describe_portal conn portal_name <> 1 then
+        signal_error conn)
+
   method get_result =
     let res = wrap_conn Stub.get_result in
     if Stub.result_isnull res then None else Some (new result res)

lib/postgresql.mli

@@ -617,6 +617,20 @@ object
 
       @raise Error if there is a connection error. *)
 
+  method send_describe_prepared : string -> unit
+  (** [#send_describe_prepared stm_name] sends an request for a description of
+      a prepared query without waiting for the result.  The result must be
+      fetched with {!get_result} when it becomes available, otherwise does the
+      same as {!describe_prepared}.
+
+      @raise Error if there is a connection error. *)
+
+  method send_describe_portal : string -> unit
+  (** [#send_describe_portal portal_name] send a request for a description of
+      the named portal.  The result must be fetched with {!get_result}.
+
+      @raise Error if there is a connection error. *)
+
   method get_result : result option
   (** [get_result] @return [Some result] of an asynchronous query if
       available or [None].

lib/postgresql_stubs.c

@@ -781,6 +781,42 @@ CAMLprim value PQsendQueryPrepared_stub(
   return Val_int(res);
 }
 
+#ifdef PG_OCAML_8_2
+CAMLprim value PQsendDescribePrepared_stub(value v_conn, value v_stm_name)
+{
+  PGconn *conn = get_conn(v_conn);
+  const char *stm_name = String_val(v_stm_name);
+  int res;
+  res = PQsendDescribePrepared(conn, stm_name);
+  return Val_int(res);
+}
+#else
+CAMLprim value
+PQsendDescribePrepared_stub(value __unused v_conn, value __unused v_stm_name)
+{
+  caml_failwith("Postgresql.send_describe_prepared: not supported");
+  return Val_unit;
+}
+#endif
+
+#ifdef PG_OCAML_8_2
+CAMLprim value PQsendDescribePortal_stub(value v_conn, value v_portal_name)
+{
+  PGconn *conn = get_conn(v_conn);
+  const char *portal_name = String_val(v_portal_name);
+  int res;
+  res = PQsendDescribePortal(conn, portal_name);
+  return Val_int(res);
+}
+#else
+CAMLprim value
+PQsendDescribePortal_stub(value __unused v_conn, value __unused v_portal_name)
+{
+  caml_failwith("Postgresql.send_describe_portal: not supported");
+  return Val_unit;
+}
+#endif
+
 CAMLprim value PQgetResult_stub(value v_conn)
 {
   CAMLparam1(v_conn);

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: d41f7ff08798140dc9456eed5004bfce) *)
+(* DO NOT EDIT (digest: aa122ef477f44c66f8a7e36890f9c528) *)
 (*
    Regenerated by OASIS v0.4.4
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6791,6 +6791,34 @@ let setup_t =
                       flag_description = Some "Build examples";
                       flag_default = [(OASISExpr.EBool true, true)]
                    });
+               Executable
+                 ({
+                     cs_name = "async";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "examples", true)
+                        ];
+                      bs_install = [(OASISExpr.EBool true, false)];
+                      bs_path = "examples";
+                      bs_compiled_object = Best;
+                      bs_build_depends = [InternalLibrary "postgresql"];
+                      bs_build_tools =
+                        [ExternalTool "ocamldoc"; ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {exec_custom = false; exec_main_is = "async.ml"});
                Executable
                  ({
                      cs_name = "cursor";
@@ -7035,14 +7063,14 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.4";
-     oasis_digest = Some "Ö%uûfÂ$¦\157c>Ä8Þ+æ";
+     oasis_digest = Some "\207)\157;|\179\018\"\237OJ\209\030\208f\158";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7047 "setup.ml"
+# 7075 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;