From a43bf932c7119a691483682d2ab091f85cb1249a Mon Sep 17 00:00:00 2001 From: Wolfgang Bumiller Date: Tue, 22 Feb 2022 15:21:41 +0100 Subject: [PATCH] experimental direct substr support Signed-off-by: Wolfgang Bumiller --- perlmod-test/src/pkg142.rs | 5 ++++ perlmod/src/ffi.rs | 4 +++ perlmod/src/glue.c | 20 +++++++++++++ perlmod/src/scalar.rs | 59 ++++++++++++++++++++++++++++++++++++++ perlmod/src/value.rs | 11 +++++++ test.pl | 5 ++++ test.pl.expected | 2 ++ 7 files changed, 106 insertions(+) diff --git a/perlmod-test/src/pkg142.rs b/perlmod-test/src/pkg142.rs index 964e94d..252b472 100644 --- a/perlmod-test/src/pkg142.rs +++ b/perlmod-test/src/pkg142.rs @@ -80,6 +80,11 @@ mod export { fn testit(#[cv] cv: Value, arg: &str) { let _ = (cv, arg); } + + #[export(raw_return)] + fn test_substr_return(#[raw] value: Value) -> Result { + Ok(value.substr(3..6)?) + } } #[perlmod::package(name = "RSPM::EnvVarLibrary", lib = "x-${CARGO_PKG_NAME}-y")] diff --git a/perlmod/src/ffi.rs b/perlmod/src/ffi.rs index 9e0ce9f..8989886 100644 --- a/perlmod/src/ffi.rs +++ b/perlmod/src/ffi.rs @@ -405,6 +405,10 @@ extern "C" { pub fn RSPL_MAGIC_ptr(mg: *const MAGIC) -> *const libc::c_char; pub fn RSPL_MAGIC_len(mg: *const MAGIC) -> isize; pub fn RSPL_PERL_MAGIC_ext() -> libc::c_int; + + pub fn RSPL_PERL_MAGIC_substr() -> libc::c_int; + pub fn RSPL_vtbl_substr() -> *const MGVTBL; + pub fn RSPL_substr(orig: *mut SV, off: usize, len: usize) -> *mut SV; } /// Argument marker for the stack. diff --git a/perlmod/src/glue.c b/perlmod/src/glue.c index 38bef01..1c139d3 100644 --- a/perlmod/src/glue.c +++ b/perlmod/src/glue.c @@ -356,6 +356,18 @@ extern SV* RSPL_LvTARG(SV *sv) { return LvTARG(sv); } +/// Takes ownership of `orig`, returns an owned scalar. +/// This does NOT check `off` and `len`. That's up to the caller. +extern SV* RSPL_substr(SV *orig, usize off, usize len) { + SV *ret = newSV_type(SVt_PVLV); + sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0); + LvTYPE(ret) = 'x'; + LvTARG(ret) = orig; + LvTARGOFF(ret) = off; + LvTARGLEN(ret) = len; + return ret; +} + // We prefer this unsigned. //extern unsigned char RSPL_LvTYPE(SV *sv) { // return (unsigned char)LvTYPE(sv); @@ -377,6 +389,14 @@ extern void RSPL_SvGETMAGIC(SV *sv) { return SvGETMAGIC(sv); } +extern const MGVTBL* RSPL_vtbl_substr() { + return &PL_vtbl_substr; +} + +extern int RSPL_PERL_MAGIC_substr() { + return PERL_MAGIC_substr; +} + /// Create a new all-zeroes vtbl as perl docs suggest this is the safest way to /// make sure what a `PERL_MAGIC_ext` magic actually means, as the ptr value /// may be arbitrary. So this function is actually used to allocate "tags". diff --git a/perlmod/src/scalar.rs b/perlmod/src/scalar.rs index 28c863e..ecb6277 100644 --- a/perlmod/src/scalar.rs +++ b/perlmod/src/scalar.rs @@ -379,6 +379,65 @@ impl ScalarRef { } } + /// Check whether this value is a substring. + pub fn is_substr(&self) -> bool { + unsafe { + self.find_raw_magic( + Some(ffi::RSPL_PERL_MAGIC_substr()), + Some(&*ffi::RSPL_vtbl_substr()), + ) + .is_some() + } + } + + /// Create a substring from a string. + pub fn substr(&self, index: I) -> Result + where + I: std::slice::SliceIndex<[u8], Output = [u8]>, + { + let bytes = self.pv_bytes(); + let slice: &[u8] = bytes + .get(index) + .ok_or_else(|| Error::new("substr with out of bounds range"))?; + let start = unsafe { slice.as_ptr().offset_from(bytes.as_ptr()) }; + let start = usize::try_from(start).map_err(|_| Error::new("bad substr index"))?; + + Ok(unsafe { + Scalar::from_raw_move(ffi::RSPL_substr( + ffi::RSPL_SvREFCNT_inc(self.sv()), + start, + slice.len(), + )) + }) + } + + /// Try to produce a substring from an existing "base" value and a `&str`. + /// + /// Returns `None` if `substr` is not part of `value`. + pub fn substr_from_str_slice(value: &ScalarRef, substr: &str) -> Result, Error> { + let value_bytes = value.pv_bytes(); + let value_beg = value_bytes.as_ptr() as usize; + let value_end = value_beg + value_bytes.len(); + let value_range = value_beg..value_end; + + let str_bytes = substr.as_bytes(); + let str_beg = str_bytes.as_ptr() as usize; + let str_end = str_beg + str_bytes.len(); + if !value_range.contains(&str_beg) || !value_range.contains(&str_end) { + return Ok(None); + } + + // we just checked the ranges: + let start = unsafe { str_bytes.as_ptr().offset_from(value_bytes.as_ptr()) as usize }; + Ok(Some(unsafe { + Scalar::from_raw_move(ffi::RSPL_substr( + ffi::RSPL_SvREFCNT_inc(value.sv()), + start, + substr.len(), + )) + })) + } + /// Attach magic to this value. /// /// # Safety diff --git a/perlmod/src/value.rs b/perlmod/src/value.rs index 66ca008..8165165 100644 --- a/perlmod/src/value.rs +++ b/perlmod/src/value.rs @@ -388,6 +388,17 @@ impl Value { let _perl = Box::leak(box_); Ok(this) } + + /// Attempt to create a substring, provided the contained value is actually a string. + pub fn substr(&self, index: I) -> Result + where + I: std::slice::SliceIndex<[u8], Output = [u8]>, + { + match self { + Value::Scalar(s) => s.substr(index).map(Value::Scalar), + _ => Err(Error::new("substr called on non-scalar")), + } + } } impl From for Value { diff --git a/test.pl b/test.pl index 87baec6..5fe98ae 100644 --- a/test.pl +++ b/test.pl @@ -115,3 +115,8 @@ print("Testing optional parameters\n"); RSPM::Foo142::test_trailing_optional(1, 99); RSPM::Foo142::test_trailing_optional(2, undef); RSPM::Foo142::test_trailing_optional(3); + +print("Substring test\n"); +my $orig = "OneTwoThree"; +my $sub = RSPM::Foo142::test_substr_return($orig); +print("[$orig] [$sub]\n"); diff --git a/test.pl.expected b/test.pl.expected index 25465f9..3220595 100644 --- a/test.pl.expected +++ b/test.pl.expected @@ -43,3 +43,5 @@ Testing optional parameters 1, Some(99) 2, None 3, None +Substring test +[OneTwoThree] [Two] -- 2.39.2