Skip to content

Commit cd70e1b

Browse files
committed
Reverted to old and correct API
1 parent f381b90 commit cd70e1b

5 files changed

Lines changed: 89 additions & 59 deletions

File tree

CHANGES.md

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,9 @@
11
# Changelog
22

3-
## 8.0.0 (2024-12-17)
3+
## 8.0.1 (2024-12-20)
44

5-
- Removed superfluous and buggy `subj_start` argument. This fixes a bug in
6-
the `full_split` function where non-capturing groups are not identified
7-
as such.
5+
- Fixed a bug in the `full_split` function where non-capturing groups were
6+
not identified as such.
87
- Removed obsolete base-bytes dependency
98

109
## 7.5.1 (2024-12-07)

examples/pcregrep.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,7 @@ let _ =
7979
let try_match line =
8080
let matched =
8181
try
82-
unsafe_pcre_exec rfl rex ~pos:0 ~subj:line ovector None;
82+
unsafe_pcre_exec rfl rex ~pos:0 ~subj_start:0 ~subj:line ovector None;
8383
if !whole_lines && ovector.(1) <> String.length line then false
8484
else true
8585
with Not_found -> false

src/pcre.ml

Lines changed: 26 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -409,6 +409,7 @@ external unsafe_pcre_exec :
409409
(irflag[@untagged]) ->
410410
regexp ->
411411
pos:(int[@untagged]) ->
412+
subj_start:(int[@untagged]) ->
412413
subj:string ->
413414
int array ->
414415
callout option ->
@@ -423,6 +424,7 @@ external unsafe_pcre_dfa_exec :
423424
(irflag[@untagged]) ->
424425
regexp ->
425426
pos:(int[@untagged]) ->
427+
subj_start:(int[@untagged]) ->
426428
subj:string ->
427429
int array ->
428430
callout option ->
@@ -434,15 +436,16 @@ let pcre_dfa_exec ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?callout
434436
let rex = match pat with Some str -> regexp str | _ -> rex in
435437
let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
436438
let _, ovector = make_ovector rex in
437-
unsafe_pcre_dfa_exec iflags rex ~pos ~subj ovector callout ~workspace;
439+
unsafe_pcre_dfa_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout
440+
~workspace;
438441
ovector
439442

440443
let pcre_exec ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?callout
441444
subj =
442445
let rex = match pat with Some str -> regexp str | _ -> rex in
443446
let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
444447
let _, ovector = make_ovector rex in
445-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
448+
unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
446449
ovector
447450

448451
let exec ?iflags ?flags ?rex ?pat ?pos ?callout subj =
@@ -630,7 +633,8 @@ let replace ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
630633
cur_pos > subj_len
631634
||
632635
try
633-
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj ovector callout;
636+
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj_start:0 ~subj ovector
637+
callout;
634638
false
635639
with Not_found -> true
636640
then (
@@ -688,7 +692,8 @@ let qreplace ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?(templ = "")
688692
cur_pos > subj_len
689693
||
690694
try
691-
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj ovector callout;
695+
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj_start:0 ~subj ovector
696+
callout;
692697
false
693698
with Not_found -> true
694699
then (
@@ -740,7 +745,8 @@ let substitute_substrings ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
740745
cur_pos > subj_len
741746
||
742747
try
743-
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj ovector callout;
748+
unsafe_pcre_exec iflags rex ~pos:cur_pos ~subj_start:0 ~subj ovector
749+
callout;
744750
false
745751
with Not_found -> true
746752
then (
@@ -798,7 +804,7 @@ let replace_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
798804
failwith "Pcre.replace_first: backreference denotes nonexistent subpattern";
799805
if with_lp && nsubs = 0 then failwith "Pcre.replace_first: no backreferences";
800806
try
801-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
807+
unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
802808
let res_len, trans_lst =
803809
calc_trans_lst subgroups2 ovector subj templ subst_lst
804810
in
@@ -822,7 +828,7 @@ let qreplace_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
822828
let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
823829
let _, ovector = make_ovector rex in
824830
try
825-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
831+
unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
826832
let first = Array.unsafe_get ovector 0 in
827833
let last = Array.unsafe_get ovector 1 in
828834
let len = String.length templ in
@@ -841,7 +847,7 @@ let substitute_substrings_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
841847
let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
842848
let _, ovector = make_ovector rex in
843849
try
844-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
850+
unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
845851
let subj_len = String.length subj in
846852
let prefix_len = Array.unsafe_get ovector 0 in
847853
let last = Array.unsafe_get ovector 1 in
@@ -903,7 +909,8 @@ let internal_psplit flags rex max pos callout subj =
903909
prematch
904910
&&
905911
try
906-
unsafe_pcre_exec flags rex ~pos ~subj ovector callout;
912+
unsafe_pcre_exec flags rex ~pos ~subj_start:pos ~subj ovector
913+
callout;
907914
true
908915
with Not_found -> false
909916
then
@@ -914,7 +921,7 @@ let internal_psplit flags rex max pos callout subj =
914921
(* Calculates next accumulator state for splitting *)
915922
else if
916923
try
917-
unsafe_pcre_exec flags rex ~pos ~subj ovector callout;
924+
unsafe_pcre_exec flags rex ~pos ~subj_start:pos ~subj ovector callout;
918925
false
919926
with Not_found -> true
920927
then string_unsafe_sub subj pos len :: strs
@@ -927,8 +934,8 @@ let internal_psplit flags rex max pos callout subj =
927934
if len = 0 then "" :: strs
928935
else if
929936
try
930-
unsafe_pcre_exec (flags lor 0x0410) rex ~pos ~subj ovector
931-
callout;
937+
unsafe_pcre_exec (flags lor 0x0410) rex ~pos ~subj_start:pos
938+
~subj ovector callout;
932939
true
933940
with Not_found -> false
934941
then
@@ -1026,7 +1033,8 @@ let full_split ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?(max = 0)
10261033
prematch
10271034
&&
10281035
try
1029-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
1036+
unsafe_pcre_exec iflags rex ~pos ~subj_start:pos ~subj ovector
1037+
callout;
10301038
true
10311039
with Not_found -> false
10321040
then
@@ -1040,7 +1048,7 @@ let full_split ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?(max = 0)
10401048
(* Calculates next accumulator state for splitting *)
10411049
else if
10421050
try
1043-
unsafe_pcre_exec iflags rex ~pos ~subj ovector callout;
1051+
unsafe_pcre_exec iflags rex ~pos ~subj_start:pos ~subj ovector callout;
10441052
false
10451053
with Not_found -> true
10461054
then
@@ -1055,8 +1063,8 @@ let full_split ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?(max = 0)
10551063
let empty_groups = handle_subgroups [] in
10561064
if
10571065
try
1058-
unsafe_pcre_exec (iflags lor 0x0410) rex ~pos ~subj ovector
1059-
callout;
1066+
unsafe_pcre_exec (iflags lor 0x0410) rex ~pos ~subj_start:pos
1067+
~subj ovector callout;
10601068
true
10611069
with Not_found -> false
10621070
then
@@ -1066,10 +1074,10 @@ let full_split ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0) ?(max = 0)
10661074
Delim (string_unsafe_sub subj first (last - first))
10671075
in
10681076
let new_strs =
1069-
let delims =
1077+
let tmp_strs =
10701078
if prematch then strs else empty_groups @ (Delim "" :: strs)
10711079
in
1072-
handle_subgroups (delim :: delims)
1080+
handle_subgroups (delim :: tmp_strs)
10731081
in
10741082
loop new_strs (cnt - 1) last false
10751083
else

src/pcre.mli

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1042,13 +1042,14 @@ val unsafe_pcre_exec :
10421042
irflag ->
10431043
regexp ->
10441044
pos:int ->
1045+
subj_start:int ->
10451046
subj:string ->
10461047
int array ->
10471048
callout option ->
10481049
unit
1049-
(** [unsafe_pcre_exec flags rex ~pos ~subj offset_vector callout]. You should
1050-
read the C-source to know what happens. If you do not understand it -
1051-
{b don't use this function!} *)
1050+
(** [unsafe_pcre_exec flags rex ~pos ~subj_start ~subj offset_vector callout].
1051+
You should read the C-source to know what happens. If you do not understand
1052+
it - {b don't use this function!} *)
10521053

10531054
val make_ovector : regexp -> int * int array
10541055
(** [make_ovector regexp] calculates the tuple (subgroups2, ovector) which is
@@ -1058,11 +1059,12 @@ val unsafe_pcre_dfa_exec :
10581059
irflag ->
10591060
regexp ->
10601061
pos:int ->
1062+
subj_start:int ->
10611063
subj:string ->
10621064
int array ->
10631065
callout option ->
10641066
workspace:int array ->
10651067
unit
1066-
(** [unsafe_pcre_dfa_exec flags rex ~pos ~subj offset_vector callout ~workpace].
1067-
You should read the C-source to know what happens. If you do not understand
1068-
it - {b don't use this function!} *)
1068+
(** [unsafe_pcre_dfa_exec flags rex ~pos ~subj_start ~subj offset_vector callout
1069+
~workpace]. You should read the C-source to know what happens. If you do
1070+
not understand it - {b don't use this function!} *)

src/pcre_stubs.c

Lines changed: 51 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ typedef const unsigned char *chartables; /* Type of chartable sets */
7272

7373
/* Contents of callout data */
7474
struct cod {
75+
long subj_start; /* Start of subject string */
7576
value *v_substrings_p; /* Pointer to substrings matched so far */
7677
value *v_cof_p; /* Pointer to callout function */
7778
value v_exn; /* Possible exception raised by callout function */
@@ -124,13 +125,21 @@ struct pcre_ocaml_tables {
124125
and OCaml chooses the larger possibility for representing integers when
125126
available (also in arrays) - not so the PCRE!
126127
*/
127-
static inline void copy_ovector(const int *ovec_src, caml_int_ptr ovec_dst,
128-
int subgroups2) {
129-
while (subgroups2--) {
130-
*ovec_dst = Val_int(*ovec_src);
131-
--ovec_src;
132-
--ovec_dst;
133-
}
128+
static inline void copy_ovector(long subj_start, const int *ovec_src,
129+
caml_int_ptr ovec_dst, int subgroups2) {
130+
if (subj_start == 0)
131+
while (subgroups2--) {
132+
*ovec_dst = Val_int(*ovec_src);
133+
--ovec_src;
134+
--ovec_dst;
135+
}
136+
else
137+
while (subgroups2--) {
138+
*ovec_dst =
139+
(*ovec_src == -1) ? Val_int(-1) : Val_long(*ovec_src + subj_start);
140+
--ovec_src;
141+
--ovec_dst;
142+
}
134143
}
135144

136145
/* Callout handler */
@@ -153,13 +162,14 @@ static int pcre_callout_handler(pcre_callout_block *cb) {
153162
const int *ovec_src = cb->offset_vector + subgroups2_1;
154163
caml_int_ptr ovec_dst =
155164
(long *)&Field(Field(v_substrings, 1), 0) + subgroups2_1;
165+
long subj_start = cod->subj_start;
156166

157-
copy_ovector(ovec_src, ovec_dst, subgroups2);
167+
copy_ovector(subj_start, ovec_src, ovec_dst, subgroups2);
158168

159169
Field(v_callout_data, 0) = Val_int(cb->callout_number);
160170
Field(v_callout_data, 1) = v_substrings;
161-
Field(v_callout_data, 2) = Val_int(cb->start_match);
162-
Field(v_callout_data, 3) = Val_int(cb->current_position);
171+
Field(v_callout_data, 2) = Val_int(cb->start_match + subj_start);
172+
Field(v_callout_data, 3) = Val_int(cb->current_position + subj_start);
163173
Field(v_callout_data, 4) = Val_int(capture_top);
164174
Field(v_callout_data, 5) = Val_int(cb->capture_last);
165175
Field(v_callout_data, 6) = Val_int(cb->pattern_position);
@@ -538,14 +548,15 @@ static inline void handle_exec_error(char *loc, const int ret) {
538548
}
539549

540550
static inline void handle_pcre_exec_result(int *ovec, value v_ovec,
541-
long ovec_len, int ret) {
551+
long ovec_len, long subj_start,
552+
int ret) {
542553
caml_int_ptr ocaml_ovec = (caml_int_ptr)&Field(v_ovec, 0);
543554
const int subgroups2 = ret * 2;
544555
const int subgroups2_1 = subgroups2 - 1;
545556
const int *ovec_src = ovec + subgroups2_1;
546557
caml_int_ptr ovec_clear_stop = ocaml_ovec + (ovec_len * 2) / 3;
547558
caml_int_ptr ovec_dst = ocaml_ovec + subgroups2_1;
548-
copy_ovector(ovec_src, ovec_dst, subgroups2);
559+
copy_ovector(subj_start, ovec_src, ovec_dst, subgroups2);
549560
while (++ovec_dst < ovec_clear_stop)
550561
*ovec_dst = -1;
551562
}
@@ -556,21 +567,28 @@ static inline void handle_pcre_exec_result(int *ovec, value v_ovec,
556567
function */
557568

558569
CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
559-
value v_subj, value v_ovec, value v_maybe_cof,
560-
value v_workspace) {
570+
intnat v_subj_start, value v_subj, value v_ovec,
571+
value v_maybe_cof, value v_workspace) {
561572
int ret;
562573
int is_dfa = v_workspace != (value)NULL;
563-
long pos = v_pos, len = caml_string_length(v_subj);
574+
long pos = v_pos, len = caml_string_length(v_subj), subj_start = v_subj_start;
564575
long ovec_len = Wosize_val(v_ovec);
565576

566-
if (pos > len || pos < 0)
577+
if (pos > len || pos < subj_start)
567578
caml_invalid_argument("Pcre.pcre_exec_stub: illegal position");
568579

580+
if (subj_start > len || subj_start < 0)
581+
caml_invalid_argument("Pcre.pcre_exec_stub: illegal subject start");
582+
583+
pos -= subj_start;
584+
len -= subj_start;
585+
569586
{
570-
const pcre *code = get_rex(v_rex); /* Compiled pattern */
571-
const pcre_extra *extra = get_extra(v_rex); /* Extra info */
572-
const char *ocaml_subj = String_val(v_subj); /* Subject string */
573-
const int opt = v_opt; /* Runtime options */
587+
const pcre *code = get_rex(v_rex); /* Compiled pattern */
588+
const pcre_extra *extra = get_extra(v_rex); /* Extra info */
589+
const char *ocaml_subj =
590+
String_val(v_subj) + subj_start; /* Subject string */
591+
const int opt = v_opt; /* Runtime options */
574592

575593
/* Special case when no callout functions specified */
576594
if (Is_none(v_maybe_cof)) {
@@ -587,7 +605,7 @@ CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
587605
if (ret < 0)
588606
handle_exec_error("pcre_exec_stub", ret);
589607
else
590-
handle_pcre_exec_result(ovec, v_ovec, ovec_len, ret);
608+
handle_pcre_exec_result(ovec, v_ovec, ovec_len, subj_start, ret);
591609
}
592610

593611
/* There are callout functions */
@@ -598,7 +616,7 @@ CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
598616
int *ovec = caml_stat_alloc(sizeof(int) * ovec_len);
599617
int workspace_len;
600618
int *workspace;
601-
struct cod cod = {(value *)NULL, (value *)NULL, (value)NULL};
619+
struct cod cod = {0, (value *)NULL, (value *)NULL, (value)NULL};
602620
struct pcre_extra new_extra =
603621
#ifdef PCRE_EXTRA_MATCH_LIMIT_RECURSION
604622
#ifdef PCRE_EXTRA_MARK
@@ -614,6 +632,7 @@ CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
614632
{PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL};
615633
#endif
616634

635+
cod.subj_start = subj_start;
617636
memcpy(subj, ocaml_subj, len);
618637

619638
Begin_roots4(v_rex, v_cof, v_substrings, v_ovec);
@@ -658,7 +677,7 @@ CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
658677
else
659678
handle_exec_error("pcre_exec_stub(callout)", ret);
660679
} else {
661-
handle_pcre_exec_result(ovec, v_ovec, ovec_len, ret);
680+
handle_pcre_exec_result(ovec, v_ovec, ovec_len, subj_start, ret);
662681
if (is_dfa) {
663682
caml_int_ptr ocaml_workspace_dst =
664683
(caml_int_ptr)&Field(v_workspace, 0);
@@ -680,23 +699,25 @@ CAMLprim value pcre_exec_stub0(intnat v_opt, value v_rex, intnat v_pos,
680699
}
681700

682701
CAMLprim value pcre_exec_stub(intnat v_opt, value v_rex, intnat v_pos,
683-
value v_subj, value v_ovec, value v_maybe_cof) {
684-
return pcre_exec_stub0(v_opt, v_rex, v_pos, v_subj, v_ovec, v_maybe_cof,
685-
(value)NULL);
702+
intnat v_subj_start, value v_subj, value v_ovec,
703+
value v_maybe_cof) {
704+
return pcre_exec_stub0(v_opt, v_rex, v_pos, v_subj_start, v_subj, v_ovec,
705+
v_maybe_cof, (value)NULL);
686706
}
687707

688708
/* Byte-code hook for pcre_exec_stub
689709
Needed, because there are more than 5 arguments */
690710
CAMLprim value pcre_exec_stub_bc(value *argv, int __unused argn) {
691-
return pcre_exec_stub0(Int_val(argv[0]), argv[1], Int_val(argv[2]), argv[3],
692-
argv[4], argv[5], (value)NULL);
711+
return pcre_exec_stub0(Int_val(argv[0]), argv[1], Int_val(argv[2]),
712+
Int_val(argv[3]), argv[4], argv[5], argv[6],
713+
(value)NULL);
693714
}
694715

695716
/* Byte-code hook for pcre_dfa_exec_stub
696717
Needed, because there are more than 5 arguments */
697718
CAMLprim value pcre_dfa_exec_stub_bc(value *argv, int __unused argn) {
698-
return pcre_exec_stub0(Int_val(argv[0]), argv[1], Int_val(argv[2]), argv[3],
699-
argv[4], argv[5], argv[6]);
719+
return pcre_exec_stub0(Int_val(argv[0]), argv[1], Int_val(argv[2]),
720+
Int_val(argv[3]), argv[4], argv[5], argv[6], argv[7]);
700721
}
701722

702723
static struct custom_operations tables_ops = {

0 commit comments

Comments
 (0)