New upstream version 4.6.0
Stephane Glondu authored 3 years ago
Stéphane Glondu committed 3 years ago
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 | ||
0 | 10 | ### 4.5.2 (2019-10-28) |
1 | 11 | |
2 | 12 | * Switched from `caml_alloc_custom` to `caml_alloc_custom_mem`. |
0 | 0 | (lang dune 1.10) |
1 | 1 | (name postgresql) |
2 | (version 4.5.2) | |
2 | (version 4.6.0) | |
3 | 3 | |
4 | 4 | (generate_opam_files true) |
5 | 5 | |
24 | 24 | (depends |
25 | 25 | (ocaml (>= 4.08)) |
26 | 26 | (dune (>= 1.10)) |
27 | dune-configurator | |
27 | 28 | (base :build) |
28 | 29 | (stdio :build) |
29 | 30 | (conf-postgresql :build) |
46 | 46 | (id SERIAL PRIMARY KEY, a INTEGER NOT NULL, b TEXT NOT NULL)"; |
47 | 47 | assert ((fetch_single_result c)#status = Command_ok); |
48 | 48 | |
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 | ||
49 | 56 | (* Populate using a prepared statement. *) |
50 | 57 | c#send_prepare "test_ins" |
51 | 58 | "INSERT INTO postgresql_ocaml_async (a, b) VALUES ($1, $2)"; |
78 | 85 | Printf.printf "%s %s %s\n" |
79 | 86 | (r#getvalue i 0) (r#getvalue i 1) (r#getvalue i 2) |
80 | 87 | done; |
88 | ||
89 | (* Run it in single-row mode. *) | |
81 | 90 | 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 | |
83 | 93 | match fetch_result c with |
84 | 94 | | None -> assert false |
85 | | Some r -> | |
95 | | Some r when i < 2 -> | |
86 | 96 | assert (r#status = Single_tuple); |
87 | 97 | 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) | |
89 | 101 | 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) | |
91 | 107 | |
92 | 108 | let main () = |
93 | 109 | (* Async connect and test. *) |
103 | 119 | finish_conn (Obj.magic c#socket) (fun () -> c#reset_poll) Polling_writing; |
104 | 120 | if c#status = Bad then failwith_f "Reset connection bad: %s" c#error_message; |
105 | 121 | assert (c#status = Ok); |
122 | c#set_notice_processing `Quiet; | |
106 | 123 | test c |
107 | 124 | |
108 | 125 | let _ = |
0 | version: "4.5.2" | |
0 | version: "4.6.0" | |
1 | 1 | # This file is generated by dune, edit dune-project instead |
2 | 2 | opam-version: "2.0" |
3 | 3 | build: [ |
23 | 23 | depends: [ |
24 | 24 | "ocaml" {>= "4.08"} |
25 | 25 | "dune" {>= "1.10"} |
26 | "dune-configurator" | |
26 | 27 | "base" {build} |
27 | 28 | "stdio" {build} |
28 | 29 | "conf-postgresql" {build} |
564 | 564 | |
565 | 565 | external set_notice_processor : |
566 | 566 | connection -> (string -> unit) -> unit = "PQsetNoticeProcessor_stub" |
567 | ||
568 | external set_notice_processor_num : | |
569 | connection -> int -> unit = "PQsetNoticeProcessor_num" | |
567 | 570 | |
568 | 571 | |
569 | 572 | (* Large objects *) |
881 | 884 | method set_notice_processor f = |
882 | 885 | wrap_conn (fun conn -> Stub.set_notice_processor conn f) |
883 | 886 | |
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 | ||
884 | 891 | |
885 | 892 | (* Accessors *) |
886 | 893 |
204 | 204 | (** [string_of_ftype ftype] converts [ftype] to a string. *) |
205 | 205 | |
206 | 206 | 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]. *) | |
208 | 208 | |
209 | 209 | |
210 | 210 | (** {2 Handling results of commands and queries} *) |
584 | 584 | method set_notice_processor : (string -> unit) -> unit |
585 | 585 | (** [#set_notice_processor] controls reporting of notice and warning |
586 | 586 | 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. | |
587 | 599 | |
588 | 600 | @raise Error if there is a connection error. |
589 | 601 | *) |
816 | 816 | else { |
817 | 817 | /* Assume binary format! */ |
818 | 818 | 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; | |
821 | 820 | } |
822 | 821 | CAMLreturn(v_str); |
823 | 822 | } |
871 | 870 | char *buf = (char *) PQunescapeBytea((unsigned char*) str, &res_len); |
872 | 871 | if (buf == NULL) caml_failwith("Postgresql: illegal bytea string"); |
873 | 872 | 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); | |
876 | 874 | PQfreemem(buf); |
877 | 875 | return v_res; |
878 | 876 | } |
923 | 921 | } else { |
924 | 922 | /* Assume binary format! */ |
925 | 923 | 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; | |
928 | 925 | } |
929 | 926 | CAMLreturn(v_str); |
930 | 927 | } |
1103 | 1100 | } |
1104 | 1101 | |
1105 | 1102 | noalloc_conn_info_intnat(PQconsumeInput) |
1106 | noalloc_conn_info(PQisBusy, Val_bool) | |
1103 | ||
1107 | 1104 | noalloc_conn_info_intnat(PQflush) |
1108 | 1105 | 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 | } | |
1109 | 1117 | |
1110 | 1118 | CAMLprim value PQCancel_stub(value v_conn) |
1111 | 1119 | { |
1137 | 1145 | caml_stat_free(buf); |
1138 | 1146 | caml_failwith("Postgresql.escape_string_conn: failed to escape string"); |
1139 | 1147 | } 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); | |
1142 | 1149 | caml_stat_free(buf); |
1143 | 1150 | return v_res; |
1144 | 1151 | } |
1160 | 1167 | (char *) PQescapeByteaConn( |
1161 | 1168 | get_conn(v_conn), |
1162 | 1169 | (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); | |
1165 | 1171 | PQfreemem(buf); |
1166 | 1172 | return v_res; |
1167 | 1173 | } |
1286 | 1292 | case -2: |
1287 | 1293 | CAMLreturn(Val_int(2)); /* Get_copy_error */ |
1288 | 1294 | 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); | |
1291 | 1296 | PQfreemem(buf); |
1292 | 1297 | v_res = caml_alloc_small(1, 0); /* Get_copy_data */ |
1293 | 1298 | Field(v_res, 0) = v_buf; |
1397 | 1402 | static inline void notice_ml(void *cb, const char *msg) |
1398 | 1403 | { |
1399 | 1404 | 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. */ | |
1403 | 1408 | caml_leave_blocking_section(); |
1404 | 1409 | v_msg = make_string(msg); |
1405 | 1410 | caml_callback(((np_callback *) cb)->v_cb, v_msg); |
1414 | 1419 | return Val_unit; |
1415 | 1420 | } |
1416 | 1421 | |
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 | } | |
1417 | 1447 | |
1418 | 1448 | /* Large objects */ |
1419 | 1449 |