mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

embed.fnc: Add EPTRtermNUL

Browse Source 
Some functions take arguments that point to the terminating NUL
character of a string.  This commit adds a way to declare in embed.fnc
that a given argument is of that kind.
This commit is contained in:
Karl Williamson 2025-12-16 12:33:42 -07:00 committed by Karl Williamson
parent e3f7e781f3
commit ea15ca3786
3 changed files with 51 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
autodoc.pl
View File

@ -622,7 +622,7 @@ sub check_and_add_proto_defn {
my @munged_args= $args_ref->@*;
s/\b(?:NN|NULLOK|[SM]PTR|EPTRQ?)\b\s+//g for @munged_args;
s/\b(?:NN|NULLOK|[SM]PTR|EPTR\w+)\b\s+//g for @munged_args;
my $flags_sans_d = $flags;
my $docs_expected = $flags_sans_d =~ s/d//g;

26
embed.fnc
View File

@ -219,22 +219,26 @@
: EPTRgt is like EPTRge, but the called function need not be prepared to
: handle the case of an empty string; the value of this pointer must
: be strictly greater than the corresponding MPTR or SPTR.
: EPTRtermNUL means that the string delimitted by it and its corresponding
: SPTR must be NUL-terminated. This parameter points to that
: terminating NUL character. That means that when the string looks
: empty, it really contains a single NUL.
:
: To summarize, either
: To summarize, one of:
: SPTR <= MPTR < EPTRgt
: or
: SPTR <= MPTR <= EPTRge
: SPTR <= MPTR <= EPTR && *EPTR == '\0'
: In each equation all three or any two of the constraints must be present.
:
: When only two constraints are present and one of them is either EPTRge or
: EPTRgt, the difference between your choosing to use SPTR or MPTR for the
: other one becomes somewhat fuzzy; the generated assertion will be the same
: whichever constraint is used. You should choose the one that makes the
: most sense for the semantics of the parameter. For example, there are
: currently some functions with parameters named 'curpos', and no SPTR
: parameter exists. The name of the parameter clearly indicates it isn't
: necessarily the starting position of the string, so using MPTR as the
: constraint makes the most sense.
: When only two constraints are present and one of them is an EPTR form, the
: difference between your choosing to use SPTR or MPTR for the other one
: becomes somewhat fuzzy; the generated assertion will be the same whichever
: constraint is used. You should choose the one that makes the most sense
: for the semantics of the parameter. For example, there are currently some
: functions with parameters named 'curpos', and no SPTR parameter exists.
: The name of the parameter clearly indicates it isn't necessarily the
: starting position of the string, so using MPTR as the constraint makes the
: most sense.
:
: The parameters for the function can be in any order, except if a function
: has multiple different character strings, all the parameters for the first

31
regen/embed.pl
View File

@ -3822,15 +3822,21 @@ sub generate_proto_h {
my $ptr_type; # E, M, and S are the three types
# corresponding respectively to EPTR,
# MPTR, and SPTR
my $ptr_name; # The full name of $ptr_type
my $equal = ""; # set to "=" if can be equal to previous
# pointer, empty if not
if ($arg =~ s/ \b ( EPTRgt | EPTRge | MPTR | SPTR ) \b //x)
if ($arg =~ s/ \b ( EPTRgt
| EPTRge
| EPTRtermNUL
| MPTR
| SPTR )
\b //x)
{
my $name = $1;
$ptr_type = substr($name, 0, 1);
$ptr_name = $1;
$ptr_type = substr($ptr_name, 0, 1);
$equal = "=" if $ptr_type eq 'M'
or ( $ptr_type eq 'E'
&& substr($name, -1, 1) eq 'e');
&& $ptr_name !~ /gt/);
}
# A $ptr_type is a specialized 'nn'
@ -3849,7 +3855,7 @@ sub generate_proto_h {
# times
die_at_end
":$func: $arg Use only one of NN (including"
. " EPTRge, EPTRgt, MPTR, SPTR), NULLOK, or NZ"
. " an EPTR form, MPTR, SPTR), NULLOK, or NZ"
if 0 + $nn + $nz + $nullok > 1;
push( @nonnull, $n ) if $nn;
@ -3861,8 +3867,8 @@ sub generate_proto_h {
# pointer.
if ($args_assert_line && $arg =~ /\*/) {
if ($nn + $nullok == 0) {
warn "$func: $arg needs one of: NN, EPTRge,"
. " EPTRgt, MPTR, SPTR, or NULLOK\n";
warn "$func: $arg needs one of: NN,"
. " an EPTR form, MPTR, SPTR, or NULLOK";
++$unflagged_pointers;
}
@ -3924,6 +3930,7 @@ sub generate_proto_h {
argname => $argname,
equal => $equal,
deref => $derefs,
name => $ptr_name,
);
# The motivation for all this is that some string
@ -3945,16 +3952,19 @@ sub generate_proto_h {
# 'equal' => '=',
# 'argname' => 'curpos',
# 'deref' => ''
# 'name' => 'MPTR',
# },
# 'E' => {
# 'equal' => '',
# 'argname' => 'strend',
# 'deref' => ''
# 'name' => some-value,
# },
# 'S' => {
# 'equal' => '',
# 'deref' => '',
# 'argname' => 'strbeg'
# 'name' => 'SPTR',
# }
# }
#
@ -4031,6 +4041,12 @@ sub generate_proto_h {
my $upper_obj= $string->{$i->[1]} or next;
my $lower = "$lower_obj->{deref}$lower_obj->{argname}";
my $upper= "$upper_obj->{deref}$upper_obj->{argname}";
if ($upper_obj->{name} eq 'EPTRtermNUL') {
push @asserts, "assert($lower <= $upper)";
push @asserts, "assert(*$upper == '\\0')";
}
else {
my $equal = $upper_obj->{equal};
# This reduces to either;
@ -4042,6 +4058,7 @@ sub generate_proto_h {
push @asserts, "assert($lower <$equal $upper)";
}
}
}
$ret .= join ", ", @$args;
}