Codebase list postgresql-ocaml / 09a97b2
New upstream version 4.6.0 Stephane Glondu authored 3 years ago Stéphane Glondu committed 3 years ago
7 changed file(s) with 101 addition(s) and 23 deletion(s). Raw diff Collapse all Expand all
0 ### 4.6.0 (2020-05-22)
1
2 * Fixed missing runtime release during calls to PQisBusy.
3
4 * Added a temporary workaround for dealing with notice processing and
5 asynchronous operations.
6
7 Thanks to Petter A. Urkedal for the patch!
8
9
010 ### 4.5.2 (2019-10-28)
111
212 * Switched from `caml_alloc_custom` to `caml_alloc_custom_mem`.
00 (lang dune 1.10)
11 (name postgresql)
2 (version 4.5.2)
2 (version 4.6.0)
33
44 (generate_opam_files true)
55
2424 (depends
2525 (ocaml (>= 4.08))
2626 (dune (>= 1.10))
27 dune-configurator
2728 (base :build)
2829 (stdio :build)
2930 (conf-postgresql :build)
4646 (id SERIAL PRIMARY KEY, a INTEGER NOT NULL, b TEXT NOT NULL)";
4747 assert ((fetch_single_result c)#status = Command_ok);
4848
49 (* Create another table which will trigger a notice. *)
50 c#send_query "\
51 CREATE TEMPORARY TABLE postgresql_ocaml_async_2 \
52 (id INTEGER PRIMARY KEY \
53 REFERENCES postgresql_ocaml_async ON DELETE CASCADE)";
54 assert ((fetch_single_result c)#status = Command_ok);
55
4956 (* Populate using a prepared statement. *)
5057 c#send_prepare "test_ins"
5158 "INSERT INTO postgresql_ocaml_async (a, b) VALUES ($1, $2)";
7885 Printf.printf "%s %s %s\n"
7986 (r#getvalue i 0) (r#getvalue i 1) (r#getvalue i 2)
8087 done;
88
89 (* Run it in single-row mode. *)
8190 c#send_query_prepared "test_sel";
82 for i = 0 to 1 do
91 c#set_single_row_mode;
92 for i = 0 to 2 do
8393 match fetch_result c with
8494 | None -> assert false
85 | Some r ->
95 | Some r when i < 2 ->
8696 assert (r#status = Single_tuple);
8797 Printf.printf "%s %s %s\n"
88 (r#getvalue i 0) (r#getvalue i 1) (r#getvalue i 2)
98 (r#getvalue 0 0) (r#getvalue 0 1) (r#getvalue 0 2)
99 | Some r ->
100 assert (r#status = Tuples_ok)
89101 done;
90 assert (fetch_result c = None)
102 assert (fetch_result c = None);
103
104 (* Drop the main table. *)
105 c#send_query "DROP TABLE postgresql_ocaml_async CASCADE";
106 assert ((fetch_single_result c)#status = Command_ok)
91107
92108 let main () =
93109 (* Async connect and test. *)
103119 finish_conn (Obj.magic c#socket) (fun () -> c#reset_poll) Polling_writing;
104120 if c#status = Bad then failwith_f "Reset connection bad: %s" c#error_message;
105121 assert (c#status = Ok);
122 c#set_notice_processing `Quiet;
106123 test c
107124
108125 let _ =
0 version: "4.5.2"
0 version: "4.6.0"
11 # This file is generated by dune, edit dune-project instead
22 opam-version: "2.0"
33 build: [
2323 depends: [
2424 "ocaml" {>= "4.08"}
2525 "dune" {>= "1.10"}
26 "dune-configurator"
2627 "base" {build}
2728 "stdio" {build}
2829 "conf-postgresql" {build}
564564
565565 external set_notice_processor :
566566 connection -> (string -> unit) -> unit = "PQsetNoticeProcessor_stub"
567
568 external set_notice_processor_num :
569 connection -> int -> unit = "PQsetNoticeProcessor_num"
567570
568571
569572 (* Large objects *)
881884 method set_notice_processor f =
882885 wrap_conn (fun conn -> Stub.set_notice_processor conn f)
883886
887 method set_notice_processing (h : [`Stderr | `Quiet]) =
888 let i = match h with `Stderr -> 0 | `Quiet -> 1 in
889 wrap_conn (fun conn -> Stub.set_notice_processor_num conn i)
890
884891
885892 (* Accessors *)
886893
204204 (** [string_of_ftype ftype] converts [ftype] to a string. *)
205205
206206 val ftype_of_string : string -> ftype
207 (** [string_of_ftype ftype] converts [ftype] to a string. *)
207 (** [string_of_ftype ftype] converts string to a [ftype]. *)
208208
209209
210210 (** {2 Handling results of commands and queries} *)
584584 method set_notice_processor : (string -> unit) -> unit
585585 (** [#set_notice_processor] controls reporting of notice and warning
586586 messages generated by a connection.
587
588 {e Warning:} This function is unsafe in combination with a number of libpq
589 entry points, and should not be used for now. As a workaround,
590 {!#set_notice_processing} can be used to silence notices, if this is more
591 appropriate than the default behaviour of printing them to standard error.
592
593 @raise Error if there is a connection error.
594 *)
595
596 method set_notice_processing : [`Stderr | `Quiet] -> unit
597 (** [#set_notice_processing] controls reporting of notice and warning messages
598 generated by a connection by providing predefined callbacks.
587599
588600 @raise Error if there is a connection error.
589601 *)
816816 else {
817817 /* Assume binary format! */
818818 size_t len = PQgetlength(res, tup_num, field_num);
819 v_str = len ? caml_alloc_string(len) : v_empty_string;
820 memcpy(String_val(v_str), str, len);
819 v_str = len ? caml_alloc_initialized_string(len, str) : v_empty_string;
821820 }
822821 CAMLreturn(v_str);
823822 }
871870 char *buf = (char *) PQunescapeBytea((unsigned char*) str, &res_len);
872871 if (buf == NULL) caml_failwith("Postgresql: illegal bytea string");
873872 else {
874 value v_res = caml_alloc_string(res_len);
875 memcpy(String_val(v_res), buf, res_len);
873 value v_res = caml_alloc_initialized_string(res_len, buf);
876874 PQfreemem(buf);
877875 return v_res;
878876 }
923921 } else {
924922 /* Assume binary format! */
925923 size_t len = PQgetlength(res, tup_num, field_num);
926 v_str = len ? caml_alloc_string(len) : v_empty_string;
927 memcpy(String_val(v_str), str, len);
924 v_str = len ? caml_alloc_initialized_string(len, str) : v_empty_string;
928925 }
929926 CAMLreturn(v_str);
930927 }
11031100 }
11041101
11051102 noalloc_conn_info_intnat(PQconsumeInput)
1106 noalloc_conn_info(PQisBusy, Val_bool)
1103
11071104 noalloc_conn_info_intnat(PQflush)
11081105 noalloc_conn_info_intnat(PQsocket)
1106
1107 CAMLprim value PQisBusy_stub(value v_conn)
1108 {
1109 CAMLparam1(v_conn);
1110 PGconn *conn = get_conn(v_conn);
1111 bool res;
1112 caml_enter_blocking_section();
1113 res = PQisBusy(conn);
1114 caml_leave_blocking_section();
1115 CAMLreturn(Val_bool(res));
1116 }
11091117
11101118 CAMLprim value PQCancel_stub(value v_conn)
11111119 {
11371145 caml_stat_free(buf);
11381146 caml_failwith("Postgresql.escape_string_conn: failed to escape string");
11391147 } else {
1140 value v_res = caml_alloc_string(n_written);
1141 memcpy(String_val(v_res), buf, n_written);
1148 value v_res = caml_alloc_initialized_string(n_written, buf);
11421149 caml_stat_free(buf);
11431150 return v_res;
11441151 }
11601167 (char *) PQescapeByteaConn(
11611168 get_conn(v_conn),
11621169 (unsigned char *) String_val(v_from) + pos_from, len, &res_len);
1163 value v_res = caml_alloc_string(--res_len);
1164 memcpy(String_val(v_res), buf, res_len);
1170 value v_res = caml_alloc_initialized_string(--res_len, buf);
11651171 PQfreemem(buf);
11661172 return v_res;
11671173 }
12861292 case -2:
12871293 CAMLreturn(Val_int(2)); /* Get_copy_error */
12881294 default:
1289 v_buf = caml_alloc_string(res);
1290 memcpy(String_val(v_buf), buf, res);
1295 v_buf = caml_alloc_initialized_string(res, buf);
12911296 PQfreemem(buf);
12921297 v_res = caml_alloc_small(1, 0); /* Get_copy_data */
12931298 Field(v_res, 0) = v_buf;
13971402 static inline void notice_ml(void *cb, const char *msg)
13981403 {
13991404 value v_msg;
1400 /* CR mmottl for mmottl: this is not reliable and can lead to segfaults,
1401 because the runtime lock may already be held (but not usually).
1402 A runtime feature is needed to fully support this. */
1405 /* CR mmottl for mmottl: this is not reliable and can lead to deadlocks or
1406 other unintended behavior, because the runtime lock may already be held
1407 (but not usually). A runtime feature is needed to fully support this. */
14031408 caml_leave_blocking_section();
14041409 v_msg = make_string(msg);
14051410 caml_callback(((np_callback *) cb)->v_cb, v_msg);
14141419 return Val_unit;
14151420 }
14161421
1422 static void np_quiet(void __unused *arg, const char __unused *message)
1423 {
1424 }
1425
1426 static void np_stderr(void __unused *arg, const char *message)
1427 {
1428 fprintf(stderr, "%s", message);
1429 }
1430
1431 CAMLprim value PQsetNoticeProcessor_num(value v_conn, value v_cb_num)
1432 {
1433 np_decr_refcount(get_conn_cb(v_conn));
1434 set_conn_cb(v_conn, NULL);
1435 switch (Int_val(v_cb_num)) {
1436 case 0:
1437 PQsetNoticeProcessor(get_conn(v_conn), np_stderr, NULL);
1438 break;
1439 case 1:
1440 PQsetNoticeProcessor(get_conn(v_conn), np_quiet, NULL);
1441 break;
1442 default:
1443 break;
1444 }
1445 return Val_unit;
1446 }
14171447
14181448 /* Large objects */
14191449