Data-Checks-0.10000755001750001750 014660677075 12244 5ustar00leoleo000000000000Data-Checks-0.10/.editorconfig000444001750001750 5314660677075 15014 0ustar00leoleo000000000000root = true
[*.{pm,pl,t}]
indent_size = 3
Data-Checks-0.10/Build.PL000444001750001750 132714660677075 13700 0ustar00leoleo000000000000use v5;
use strict;
use warnings;
use lib 'inc';
use Module::Build::with::XSTests;
my $build = Module::Build::with::XSTests->new(
module_name => 'Data::Checks',
requires => {
perl => '5.022', # op_convert_list()
( $^V lt v5.38 ) ? (
'builtin::Backport' => 0,
) : (),
},
test_requires => {
'Test2::V0' => '0.000148',
},
configure_requires => {
'Module::Build' => '0.4004', # test_requires
},
share_dir => {
module => { "Data::Checks" => [ 'share' ] },
},
extra_compiler_flags => [qw( -Ishare/include -Iinclude -Ihax )],
c_source => [ "src/" ],
license => 'perl',
create_license => 1,
create_readme => 1,
);
$build->create_build_script;
Data-Checks-0.10/Changes000444001750001750 512214660677075 13674 0ustar00leoleo000000000000Revision history for Data-Checks
0.10 2024-08-19
[CHANGES]
* Optional flags arguments to `make_assertop`
* Neater use in optrees by passing OPf_WANT_VOID to `make_assertop`
* Optimise `All()` combinations of multiple number bounds checks
0.09 2024-07-31
[CHANGES]
* Deprecate the use of plain CODE references as constraint checkers
* Added `->check` method to constraint checker class, allowing direct
use from pureperl code
* Better formatting of debug inspection strings
* Automatically generate stringified constraint names for assert
message if one is not supplied
0.08 2024-07-16
[CHANGES]
* Added `StrMatch()`
* More efficient implementation of `Any()` and `All()` with 1
argument or in nested trees
* Support the `|` infix operator as a shorthand for `Any()`
0.07 2024-07-12
[CHANGES]
* Added `ArrayRef` and `HashRef` constraints
* Added `Any` and `All` hyper-constraints
* More extensive unit testing of constraints by automatically
generating reject cases
0.06 2024-07-09
[CHANGES]
* Added `Callable` constraint
* Apply const folding where possible at compile-time so that
constraint expressions become runtime constants
* Added a SYNOPSIS example demonstrating use with
`Syntax::Operator::Is`
0.05 2024-07-01
[CHANGES]
* Added `NumEq`, `NumRange`, various single-ended numerical bounded
constraints
* Added `StrEq`
[BUGFIXES]
* Ensure that the benchmark tests are suitable version-guarded for
external `:Checked` attribute modules
0.04 2024-06-27
[CHANGES]
* Added `Isa()` and `Maybe()` parametric constraints
* Declare `Data::Checks::Builder` version 0.43 to fix earlier version
numbering error - no actual code change
0.03 2024-06-23
[CHANGES]
* Added a few basic constraints: `Defined`, `Str`, `Num`, `Object`
* Added some cross-module integration tests for
`Signature::Attribute::Checked` and `Object::Pad::FieldAttr::Checked`
* Added SYNOPSIS documentation section giving examples of each
0.02 2024-06-21
[CHANGES]
* Added `free_checkdata()` and `gen_assertmess()` API functions
* Better management of SV reference counts
* `struct DataChecks_Checker` is now an opaque structure
0.01 2024-06-19
First version, released on an unsuspecting world.
Data-Checks-0.10/LICENSE000444001750001750 4653414660677075 13442 0ustar00leoleo000000000000This software is copyright (c) 2024 by Paul Evans .
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2024 by Paul Evans .
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Perl Artistic License 1.0 ---
This software is Copyright (c) 2024 by Paul Evans .
This is free software, licensed under:
The Perl Artistic License 1.0
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
Data-Checks-0.10/MANIFEST000444001750001750 151714660677075 13536 0ustar00leoleo000000000000.editorconfig
Build.PL
Changes
hax/ckcall_constfold.c.inc
hax/make_argcheck_aux.c.inc
hax/make_argcheck_ops.c.inc
hax/newOP_CUSTOM.c.inc
hax/optree-additions.c.inc
hax/perl-backcompat.c.inc
hax/sv_numcmp.c.inc
hax/sv_regexp_match.c.inc
hax/sv_streq.c.inc
inc/Module/Build/with/XSTests.pm
include/constraints.h
lib/Data/Checks.pm
lib/Data/Checks.xs
lib/Data/Checks/Builder.pm
LICENSE
MANIFEST This list of files
META.json
META.yml
README
share/include/DataChecks.h
src/constraints.c
t/00use.t
t/01check-obj.t
t/02check-pkg.t
t/03check-sub.t
t/10constraints.t
t/11constraints-num.t
t/12constraints-str.t
t/13constraints-structural.t
t/20inline-constraints.t
t/21assertop.t
t/22optimise-numbounds.t
t/80checks+field.t
t/80checks+signature.t
t/80match-is.t
t/95benchmark-fields.t
t/95benchmark-signature.t
t/99pod.t
t/test.c
t/test.xs
t/testcase.pm
Data-Checks-0.10/META.json000444001750001750 237114660677075 14025 0ustar00leoleo000000000000{
"abstract" : "Value constraint checking",
"author" : [
"Paul Evans "
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4234",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Data-Checks",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::CBuilder" : "0"
}
},
"configure" : {
"requires" : {
"Module::Build" : "0.4004"
}
},
"runtime" : {
"requires" : {
"File::ShareDir" : "1.00",
"perl" : "5.022"
}
},
"test" : {
"requires" : {
"Test2::V0" : "0.000148"
}
}
},
"provides" : {
"Data::Checks" : {
"file" : "lib/Data/Checks.pm",
"version" : "0.10"
},
"Data::Checks::Builder" : {
"file" : "lib/Data/Checks/Builder.pm",
"version" : "0.44"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.10",
"x_serialization_backend" : "JSON::PP version 4.16"
}
Data-Checks-0.10/META.yml000444001750001750 137414660677075 13657 0ustar00leoleo000000000000---
abstract: 'Value constraint checking'
author:
- 'Paul Evans '
build_requires:
ExtUtils::CBuilder: '0'
Test2::V0: '0.000148'
configure_requires:
Module::Build: '0.4004'
dynamic_config: 1
generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Data-Checks
provides:
Data::Checks:
file: lib/Data/Checks.pm
version: '0.10'
Data::Checks::Builder:
file: lib/Data/Checks/Builder.pm
version: '0.44'
requires:
File::ShareDir: '1.00'
perl: '5.022'
resources:
license: http://dev.perl.org/licenses/
version: '0.10'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Data-Checks-0.10/README000444001750001750 2741214660677075 13307 0ustar00leoleo000000000000NAME
Data::Checks - Value constraint checking
SYNOPSIS
With Signature::Attribute::Checked:
use v5.26;
use Sublike::Extended;
use Signature::Attribute::Checked;
use Data::Checks qw( Str );
extended sub greet ( $message :Checked(Str) ) {
say "Hello, $message";
}
greet( "world" ); # is fine
greet( undef ); # throws an exception
With Object::Pad::FieldAttr::Checked:
use v5.22;
use Object::Pad;
use Object::Pad::FieldAttr::Checked;
use Data::Checks qw( Str );
class Datum {
field $name :param :reader :Checked(Str);
}
my $x = Datum->new( name => "something" ); # is fine
my $y = Datum->new( name => undef ); # throws an exception
With Syntax::Operator::Is on Perl v5.38 or later:
use v5.38;
use Syntax::Operator::Is;
use Data::Checks qw( Num Object );
my $x = ...;
if($x is Num) {
say "x can be used as a number";
}
elsif($x is Object) {
say "x can be used as an object";
}
DESCRIPTION
This module provides functions that implement various value constraint
checking behaviours. These are the parts made visible by the use
Data::Checks ... import line, in Perl code.
It also provides the underlying common framework XS functions to assist
in writing modules that actually implement such constraint checking.
These parts are not visible in Perl code, but instead made visible at
the XS level by the #include "DataChecks.h" directive.
See the "SYNOPSIS" section above for several examples of other CPAN
modules that make direct use of these constraint checks.
CONSTRAINTS
The following constraint checks are inspired by the same-named ones in
Types::Standard. They may be called fully-qualified, or imported
lexically into the calling scope.
Note to users familiar with Types::Standard: some of these functions
behave slightly differently. In particular, these constraints are
generally happy to accept an object reference to a class that provides
a conversion overload, whereas the ones in Types::Standard often are
not. Additionally functions that are parametric take their parameters
in normal Perl function argument lists, not wrapped in additional array
references.
Defined
Defined()
Accepts any defined value, rejects only undef.
Object
Object()
Accepts any blessed object reference, rejects non-references or
references to unblessed data.
Str
Str()
Accepts any defined non-reference value, or a reference to an object in
a class that overloads stringification. Rejects undefined, unblessed
references, or references to objects in classes that do not overload
stringification.
StrEq
StrEq($s)
StrEq($s1, $s2, ...)
Since version 0.05.
Accepts any value that passes the Str check, and additionally is
exactly equal to any of the given strings.
StrMatch
StrMatch(qr/pattern/)
Since version 0.08.
Accepts any value that passes the Str check, and additionally matches
the given regexp pattern.
Remember that the pattern must be supplied as a qr/.../ expression, not
simply m/.../ or /.../.
Num
Num()
Accepts any defined non-reference value that is either a plain number,
or a string that could be used as one without warning, or a reference
to an object in a class that overloads numification.
Rejects undefined, not-a-number, strings that would raise a warning if
converted to a number, unblessed references, or references to objects
in classes that do not overload numification.
NumGT
NumGE
NumLE
NumLT
NumGT($bound)
NumGE($bound)
NumLE($bound)
NumLT($bound)
Since version 0.05.
Accepts any value that passes the Num check, and additionally is within
the bound given. NumGT and NumLT exclude the bound value itself, NumGE
and NumLE include it.
NumRange
NumRange($boundge, $boundlt)
Since version 0.05.
Accepts any value that passes the Num check, and additionally is
between the two bounds given. The lower bound is inclusive, and the
upper bound is exclusive.
This choice is made so that a set of NumRange constraints can easily be
created that cover distinct sets of numbers:
NumRange(0, 10), NumRange(10, 20), NumRange(20, 30), ...
To implement checks with both lower and upper bounds but other kinds of
inclusivity, use two Num... checks combined with an All(). For example,
to test between 0 and 100 inclusive at both ends:
All(NumGE(0), NumLE(100))
Combinations like this are internally implemented as efficiently as a
single NumRange() constraint.
NumEq
NumEq($n)
NumEq($n1, $n2, ...)
Since version 0.05.
Accepts any value that passes the Num check, and additionally is
exactly equal to any of the given numbers.
Isa
Isa($classname)
Since version 0.04.
Accepts any blessed object reference to an instance of the given class
name, or a subclass derived from it (i.e. anything accepted by the isa
operator).
ArrayRef
ArrayRef()
Since version 0.07.
Accepts any plain reference to an array, or any object reference to an
instance of a class that provides an array dereference overload.
HashRef
HashRef()
Since version 0.07.
Accepts any plain reference to a hash, or any object reference to an
instance of a class that provides a hash dereference overload.
Callable
Callable()
Since version 0.06.
Accepts any plain reference to a subroutine, or any object reference to
an instance of a class that provides a subroutine dereference overload.
Maybe
Maybe($C)
Since version 0.04.
Accepts undef in addition to anything else accepted by the given
constraint.
Any
Any($C1, $C2, ...)
Since version 0.07.
Accepts a value that is accepted by at least one of the given
constraints. Rejects if none of them accept it.
At least one constraint is required; it is an error to try to call
Any() with no arguments. If you need a constraint that accepts any
value at all, see "All".
$C1 | $C2 | ...
Since version 0.08.
This function is used to implement | operator overloading, so
constraint checks can be written using this more convenient syntax.
All
All($C1, $C2, ...)
All()
Since version 0.07.
Accepts a value that is accepted by every one of the given constraints.
Rejects if at least one of them rejects it.
Note that if no constraints are given, this accepts all possible
values. This may be useful as an "accept-all" fallback case for
generated code, or other situations where it is required to provide a
constraint check but you do not wish to constraint allowed values.
CONSTRAINT METHODS
While not intended to be called from regular Perl code, these
constraints still act like objects with the following methods.
check
$ok = $constraint->check( $value );
Since version 0.09.
Returns a boolean value indicating whether the constraint accepts the
given value.
XS FUNCTIONS
The following functions are provided by the DataChecks.h header file
for use in XS modules that implement value constraint checking.
boot_data_checks
void boot_data_checks(double ver);
Call this function from your BOOT section in order to initialise the
module and load the rest of the support functions.
ver should either be 0 or a decimal number for the module version
requirement; e.g.
boot_data_checks(0.01);
make_checkdata
struct DataChecks_Checker *make_checkdata(SV *checkspec);
Creates a struct DataChecks_Checker structure, which wraps the intent
of the value constraint check. The returned value is used as the
checker argument for the remaining functions.
The constraint check itself is specified by the SV given by checkspec,
which should come directly from the user code. The constraint check may
be specified in any of three ways:
* An object reference in a class which has a check method. Value
checks will be invoked as
$ok = $checkerobj->check( $value );
* A package name as a plain string of a package which has a check
method. Value checks will be invoked as
$ok = $checkerpkg->check( $value );
* A code reference. Value checks will be invoked with a single
argument, as
$ok = $checkersub->( $value );
Since version 0.09 this form is now deprecated, because it does not
easily support a way to query the constraint for its name or
stringified form, which is useful when generating error messages.
* Additionally, the constraint check functions provided by this
module may be implemented using any of the above mechanisms, or may
use an unspecified fourth different mechanism. Outside code should
not rely on what that mechanism may be.
Once constructed into a checker structure, the choice of which
implementation is used is fixed, and if a method lookup is involved its
result is stored directly as a CV pointer for efficiency of later
invocations. In either of the first two cases, the reference count on
the checkspec SV is increased to account for the argument value used on
each invocation. In the third case, the reference SV is not retained,
but the underlying CV it refers to has its reference count increased.
free_checkdata
void free_checkdata(struct DataChecks_Checker *checker);
Releases any stored SVs in the checker structure, and the structure
itself.
gen_assertmess
void gen_assertmess(struct DataChecks_Checker *checker, SV *name, SV *constraint);
Generates and stores a message string for the assert message to be used
by "make_assertop" and "assert_value". The message will take the form
NAME requires a value satisfying CONSTRAINT
Both name and constraint SVs used as temporary strings to generate the
stored message string. Neither SV is retained by the checker directly.
make_assertop
OP *make_assertop(struct DataChecks_Checker *checker, OP *argop);
Shortcut to calling "make_assertop_flags" with flags set to zero.
make_assertop_flags
OP *make_assertop_flags(struct DataChecks_Checker *checker, U32 flags, OP *argop);
Creates an optree fragment for a value check assertion operation.
Given an optree fragment in scalar context that generates an argument
value (argop), constructs a larger optree fragment that consumes it and
checks that the value is accepted by the constraint check given by
checker. The behaviours of the returned optree fragment will depend on
the flags.
If flags is OPf_WANT_VOID the returned optree will yield nothing.
If flags is zero, the return behaviour is not otherwise specified.
check_value
bool check_value(struct DataChecks_Checker *checker, SV *value);
Checks whether a given SV is accepted by the given constraint check,
returning true if so, or false if not.
assert_value
void assert_value(struct DataChecks_Checker *checker, SV *value);
Checks whether a given SV is accepted by the given constraint check,
throwing its assertion message if it does not.
TODO
* Unit constraints - maybe Int, some plain-only variants of Str and
Num, some reference types, etc...
* Structural constraints - HashOf, ArrayOf, etc...
* Think about a convenient name for inclusive-bounded numerical
constraints.
* Look into making const-folding work with the MIN .. MAX flip-flop
operator
AUTHOR
Paul Evans
Data-Checks-0.10/hax000755001750001750 014660677075 13024 5ustar00leoleo000000000000Data-Checks-0.10/hax/ckcall_constfold.c.inc000444001750001750 440414660677075 17403 0ustar00leoleo000000000000/* vi: set ft=c : */
static bool op_is_const(OP *o)
{
switch(o->op_type) {
case OP_CONST:
return true;
case OP_LIST:
{
OP *oelem = cLISTOPo->op_first;
if(oelem->op_type == OP_PUSHMARK)
oelem = OpSIBLING(oelem);
for(; oelem; oelem = OpSIBLING(oelem))
if(oelem->op_type != OP_CONST)
return false;
return true;
}
default:
return false;
}
}
static OP *ckcall_constfold(pTHX_ OP *o, GV *namegv, SV *ckobj)
{
assert(o->op_type == OP_ENTERSUB);
OP *kid = cUNOPo->op_first;
/* The first kid is usually an ex-list whose ->op_first begins the actual args list */
if(kid->op_type == OP_NULL && kid->op_targ == OP_LIST)
kid = cUNOPx(kid)->op_first;
/* First actual arg is likely a OP_PUSHMARK */
if(kid->op_type == OP_PUSHMARK)
kid = OpSIBLING(kid);
OP *firstarg = kid;
for(; kid && OpSIBLING(kid); kid = OpSIBLING(kid)) {
if(op_is_const(kid))
continue;
return o;
}
CV *cv = GvCV(namegv);
assert(SvTYPE(cv) == SVt_PVCV);
/* We've not rejected it now, so lets invoke it and inline the result */
/* TODO: I tried invoking the actual optree by linking it, setting it as
* PL_op and invoking CALLRUNOPS(), but it seems the pad isn't set up
* correctly yet to permit this for OP_PADCV ops.
* Instead, we'll simulated it by PUSHs()ing ourselves
*/
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
for(OP *oarg = firstarg; oarg && OpSIBLING(oarg); oarg = OpSIBLING(oarg)) {
switch(oarg->op_type) {
case OP_CONST:
PUSHs(cSVOPx(oarg)->op_sv);
break;
case OP_LIST:
{
OP *oelem = cUNOPx(oarg)->op_first;
if(oelem->op_type == OP_PUSHMARK)
oelem = OpSIBLING(oelem);
for(; oelem; oelem = OpSIBLING(oelem)) {
assert(oelem->op_type == OP_CONST);
PUSHs(cSVOPx(oelem)->op_sv);
}
break;
}
}
}
PUTBACK;
/* TODO: Currently always presume scalar context */
I32 count = call_sv((SV *)cv, G_SCALAR|G_EVAL);
bool got_err = SvTRUE(GvSV(PL_errgv));
SPAGAIN;
SV *retval = SvREFCNT_inc(POPs);
PUTBACK;
FREETMPS;
LEAVE;
if(got_err)
/* Error was raised; abort */
return o;
op_free(o);
o = newSVOP(OP_CONST, 0, retval);
return o;
}
Data-Checks-0.10/hax/make_argcheck_aux.c.inc000444001750001750 132314660677075 17515 0ustar00leoleo000000000000/* vi: set ft=c : */
#ifndef make_argcheck_aux
#define make_argcheck_aux(params, opt_params, slurpy) S_make_argcheck_aux(aTHX_ params, opt_params, slurpy)
static inline UNOP_AUX_item *S_make_argcheck_aux(pTHX_ UV params, UV opt_params, char slurpy)
{
# if HAVE_PERL_VERSION(5, 31, 5)
struct op_argcheck_aux *aux = (struct op_argcheck_aux*)
PerlMemShared_malloc(sizeof(struct op_argcheck_aux));
aux->params = params;
aux->opt_params = opt_params;
aux->slurpy = slurpy;
return (UNOP_AUX_item *)aux;
# else
UNOP_AUX_item *aux = (UNOP_AUX_item *)PerlMemShared_malloc(sizeof(UNOP_AUX_item) * 3);
aux[0].iv = params;
aux[1].iv = opt_params;
aux[2].iv = slurpy;
return aux;
# endif
}
#endif
Data-Checks-0.10/hax/make_argcheck_ops.c.inc000444001750001750 553714660677075 17534 0ustar00leoleo000000000000/* vi: set ft=c : */
#define make_croak_op(message) S_make_croak_op(aTHX_ message)
static OP *S_make_croak_op(pTHX_ SV *message)
{
#if HAVE_PERL_VERSION(5, 22, 0)
sv_catpvs(message, " at %s line %d.\n");
/* die sprintf($message, (caller)[1,2]) */
return op_convert_list(OP_DIE, 0,
op_convert_list(OP_SPRINTF, 0,
op_append_list(OP_LIST,
newSVOP(OP_CONST, 0, message),
newSLICEOP(0,
op_append_list(OP_LIST,
newSVOP(OP_CONST, 0, newSViv(1)),
newSVOP(OP_CONST, 0, newSViv(2))),
newOP(OP_CALLER, 0)))));
#else
/* For some reason I can't work out, the above tree isn't correct. Attempts
* to correct it still make OP_SPRINTF crash with "Out of memory!". For now
* lets just avoid the sprintf
*/
sv_catpvs(message, "\n");
return newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
newSVOP(OP_CONST, 0, message));
#endif
}
#if HAVE_PERL_VERSION(5, 26, 0)
# define HAVE_OP_ARGCHECK
# include "make_argcheck_aux.c.inc"
#endif
#define make_argcheck_ops(required, optional, slurpy, subname) S_make_argcheck_ops(aTHX_ required, optional, slurpy, subname)
static OP *S_make_argcheck_ops(pTHX_ int required, int optional, char slurpy, SV *subname)
{
int params = required + optional;
#ifdef HAVE_OP_ARGCHECK
UNOP_AUX_item *aux = make_argcheck_aux(params, optional, slurpy);
return op_prepend_elem(OP_LINESEQ, newSTATEOP(0, NULL, NULL),
op_prepend_elem(OP_LINESEQ, newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux), NULL));
#else
/* Older perls lack the convenience of OP_ARGCHECK so we'll have to build an
* optree ourselves. For now we only support required + optional, no slurpy
*
* This code heavily inspired by Perl_parse_subsignature() in toke.c from perl 5.24
*/
OP *ret = NULL;
if(required > 0) {
SV *message = newSVpvf("Too few arguments for subroutine '%" SVf "'", subname);
/* @_ >= required or die ... */
OP *checkop =
newSTATEOP(0, NULL,
newLOGOP(OP_OR, 0,
newBINOP(OP_GE, 0,
/* scalar @_ */
op_contextualize(newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv)), G_SCALAR),
newSVOP(OP_CONST, 0, newSViv(required))),
make_croak_op(message)));
ret = op_append_list(OP_LINESEQ, ret, checkop);
}
if(!slurpy) {
SV *message = newSVpvf("Too many arguments for subroutine '%" SVf "'", subname);
/* @_ <= (required+optional) or die ... */
OP *checkop =
newSTATEOP(0, NULL,
newLOGOP(OP_OR, 0,
newBINOP(OP_LE, 0,
/* scalar @_ */
op_contextualize(newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv)), G_SCALAR),
newSVOP(OP_CONST, 0, newSViv(params))),
make_croak_op(message)));
ret = op_append_list(OP_LINESEQ, ret, checkop);
}
/* TODO: If slurpy is % then maybe complain about odd number of leftovers */
return ret;
#endif
}
Data-Checks-0.10/hax/newOP_CUSTOM.c.inc000444001750001750 1035114660677075 16237 0ustar00leoleo000000000000/* vi: set ft=c : */
/* Before perl 5.22 under -DDEBUGGING, various new*OP() functions throw assert
* failures on OP_CUSTOM.
* https://rt.cpan.org/Ticket/Display.html?id=128562
*/
#define newOP_CUSTOM(func, flags) S_newOP_CUSTOM(aTHX_ func, flags)
#define newUNOP_CUSTOM(func, flags, first) S_newUNOP_CUSTOM(aTHX_ func, flags, first)
#define newUNOP_AUX_CUSTOM(func, flags, first, aux) S_newUNOP_AUX_CUSTOM(aTHX_ func, flags, first, aux)
#define newSVOP_CUSTOM(func, flags, sv) S_newSVOP_CUSTOM(aTHX_ func, flags, sv)
#define newBINOP_CUSTOM(func, flags, first, last) S_newBINOP_CUSTOM(aTHX_ func, flags, first, last)
#define newLISTOP_CUSTOM(func, flags, first, last) S_newLISTOP_CUSTOM(aTHX_ func, flags, first, last)
#define newLOGOP_CUSTOM(func, flags, first, other) S_newLOGOP_CUSTOM(aTHX_ func, flags, first, other)
static OP *S_newOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags)
{
OP *op = newOP(OP_CUSTOM, flags);
op->op_ppaddr = func;
return op;
}
static OP *S_newUNOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first)
{
UNOP *unop;
#if HAVE_PERL_VERSION(5,22,0)
unop = (UNOP *)newUNOP(OP_CUSTOM, flags, first);
#else
NewOp(1101, unop, 1, UNOP);
unop->op_type = (OPCODE)OP_CUSTOM;
unop->op_first = first;
unop->op_flags = (U8)(flags | OPf_KIDS);
unop->op_private = (U8)(1 | (flags >> 8));
#endif
unop->op_ppaddr = func;
return (OP *)unop;
}
static OP *S_newUNOP_AUX_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, UNOP_AUX_item *aux)
{
UNOP_AUX *unop;
#if HAVE_PERL_VERSION(5,22,0)
unop = (UNOP_AUX *)newUNOP_AUX(OP_CUSTOM, flags, first, aux);
#else
croak("TODO: create newUNOP_AUX_CUSTOM");
#endif
unop->op_ppaddr = func;
return (OP *)unop;
}
static OP *S_newSVOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, SV *sv)
{
SVOP *svop;
#if HAVE_PERL_VERSION(5,22,0)
svop = (SVOP *)newSVOP(OP_CUSTOM, flags, sv);
#else
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)OP_CUSTOM;
svop->op_sv = sv;
svop->op_next = (OP *)svop;
svop->op_flags = 0;
svop->op_private = 0;
#endif
svop->op_ppaddr = func;
return (OP *)svop;
}
static OP *S_newBINOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *last)
{
BINOP *binop;
#if HAVE_PERL_VERSION(5,22,0)
binop = (BINOP *)newBINOP(OP_CUSTOM, flags, first, last);
#else
NewOp(1101, binop, 1, BINOP);
binop->op_type = (OPCODE)OP_CUSTOM;
binop->op_first = first;
first->op_sibling = last;
binop->op_last = last;
binop->op_flags = (U8)(flags | OPf_KIDS);
binop->op_private = (U8)(2 | (flags >> 8));
#endif
binop->op_ppaddr = func;
return (OP *)binop;
}
static OP *S_newLISTOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *last)
{
LISTOP *listop;
#if HAVE_PERL_VERSION(5,22,0)
listop = (LISTOP *)newLISTOP(OP_CUSTOM, flags, first, last);
#else
NewOp(1101, listop, 1, LISTOP);
listop->op_type = (OPCODE)OP_CUSTOM;
listop->op_first = first;
if(first)
first->op_sibling = last;
listop->op_last = last;
listop->op_flags = (U8)(flags | OPf_KIDS);
if(last)
listop->op_private = (U8)(2 | (flags >> 8));
else if(first)
listop->op_private = (U8)(1 | (flags >> 8));
else
listop->op_private = (U8)(flags >> 8);
#endif
listop->op_ppaddr = func;
return (OP *)listop;
}
static OP *S_newLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *other)
{
OP *o;
#if HAVE_PERL_VERSION(5,22,0)
o = newLOGOP(OP_CUSTOM, flags, first, other);
#else
/* Parts of this code copypasted from perl 5.20.0's op.c S_new_logop()
*/
LOGOP *logop;
first = op_contextualize(first, G_SCALAR);
NewOp(1101, logop, 1, LOGOP);
logop->op_type = (OPCODE)OP_CUSTOM;
logop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
logop->op_first = first;
logop->op_flags = (U8)(flags | OPf_KIDS);
logop->op_other = LINKLIST(other);
logop->op_private = (U8)(1 | (flags >> 8));
/* Link in postfix order */
logop->op_next = LINKLIST(first);
first->op_next = (OP *)logop;
first->op_sibling = other;
/* No CHECKOP for OP_CUSTOM */
o = newUNOP(OP_NULL, 0, (OP *)logop);
other->op_next = o;
#endif
/* the returned op is actually an UNOP that's either NULL or NOT; the real
* logop is the op_next of it
*/
cUNOPx(o)->op_first->op_ppaddr = func;
return o;
}
Data-Checks-0.10/hax/optree-additions.c.inc000444001750001750 516314660677075 17354 0ustar00leoleo000000000000/* vi: set ft=c : */
#define newAELEMOP(flags, first, key) S_newAELEMOP(aTHX_ flags, first, key)
static OP *S_newAELEMOP(pTHX_ U32 flags, OP *first, I32 key)
{
#if HAVE_PERL_VERSION(5,16,0)
if(key >= -128 && key < 128 && first->op_type == OP_PADAV) {
OP *o = newOP(OP_AELEMFAST_LEX, flags);
o->op_private = (I8)key;
o->op_targ = first->op_targ;
op_free(first);
return o;
}
#endif
return newBINOP(OP_AELEM, flags, first, newSVOP(OP_CONST, 0, newSViv(key)));
}
#if HAVE_PERL_VERSION(5, 22, 0)
# define HAVE_UNOP_AUX
#endif
#ifndef HAVE_UNOP_AUX
typedef struct UNOP_with_IV {
UNOP baseop;
IV iv;
} UNOP_with_IV;
#define newUNOP_with_IV(type, flags, first, iv) S_newUNOP_with_IV(aTHX_ type, flags, first, iv)
static OP *S_newUNOP_with_IV(pTHX_ I32 type, I32 flags, OP *first, IV iv)
{
/* Cargoculted from perl's op.c:Perl_newUNOP()
*/
UNOP_with_IV *op = PerlMemShared_malloc(sizeof(UNOP_with_IV) * 1);
NewOp(1101, op, 1, UNOP_with_IV);
if(!first)
first = newOP(OP_STUB, 0);
UNOP *unop = (UNOP *)op;
unop->op_type = (OPCODE)type;
unop->op_first = first;
unop->op_ppaddr = NULL;
unop->op_flags = (U8)flags | OPf_KIDS;
unop->op_private = (U8)(1 | (flags >> 8));
op->iv = iv;
return (OP *)op;
}
#endif
#define newMETHOD_REDIR_OP(rclass, methname, flags) S_newMETHOD_REDIR_OP(aTHX_ rclass, methname, flags)
static OP *S_newMETHOD_REDIR_OP(pTHX_ SV *rclass, SV *methname, I32 flags)
{
#if HAVE_PERL_VERSION(5, 22, 0)
OP *op = newMETHOP_named(OP_METHOD_REDIR, flags, methname);
# ifdef USE_ITHREADS
{
/* cargoculted from S_op_relocate_sv() */
PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
PAD_SETSV(ix, rclass);
cMETHOPx(op)->op_rclass_targ = ix;
}
# else
cMETHOPx(op)->op_rclass_sv = rclass;
# endif
#else
OP *op = newUNOP(OP_METHOD, flags,
newSVOP(OP_CONST, 0, newSVpvf("%" SVf "::%" SVf, rclass, methname)));
#endif
return op;
}
/* If `@_` is called "snail", then elements of it can be called "slugs"; i.e.
* snails without their container
*/
#define newSLUGOP(idx) S_newSLUGOP(aTHX_ idx)
static OP *S_newSLUGOP(pTHX_ int idx)
{
OP *op = newGVOP(OP_AELEMFAST, 0, PL_defgv);
op->op_private = idx;
return op;
}
#ifndef newLISTOPn
/* newLISTOPn was added in 5.39.3 */
# define newLISTOPn(type, flags, ...) S_newLISTOPn(aTHX_ type, flags, __VA_ARGS__)
static OP *S_newLISTOPn(pTHX_ OPCODE type, U32 flags, ...)
{
va_list args;
va_start(args, flags);
OP *o = newLISTOP(OP_LIST, 0, NULL, NULL);
OP *kid;
while((kid = va_arg(args, OP *)))
o = op_append_elem(OP_LIST, o, kid);
va_end(args);
return op_convert_list(type, flags, o);
}
#endif
Data-Checks-0.10/hax/perl-backcompat.c.inc000444001750001750 1456314660677075 17172 0ustar00leoleo000000000000/* vi: set ft=c : */
#define HAVE_PERL_VERSION(R, V, S) \
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
#ifndef NOT_REACHED
# define NOT_REACHED assert(0)
#endif
#ifndef SvTRUE_NN
# define SvTRUE_NN(sv) SvTRUE(sv)
#endif
#ifndef G_LIST
# define G_LIST G_ARRAY
#endif
#if !HAVE_PERL_VERSION(5, 18, 0)
typedef AV PADNAMELIST;
# define PadlistARRAY(pl) ((PAD **)AvARRAY(pl))
# define PadlistNAMES(pl) (*PadlistARRAY(pl))
typedef SV PADNAME;
# define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL)
# define PadnameLEN(pn) SvCUR(pn)
# define PadnameIsSTATE(pn) (!!SvPAD_STATE(pn))
# define PadnameOUTER(pn) (SvFAKE(pn) && !SvPAD_STATE(pn))
# define PadnamelistARRAY(pnl) AvARRAY(pnl)
# define PadnamelistMAX(pnl) AvFILLp(pnl)
# define PadARRAY(p) AvARRAY(p)
# define PadMAX(pad) AvFILLp(pad)
#endif
#if !HAVE_PERL_VERSION(5, 22, 0)
# define CvPADLIST_set(cv, padlist) (CvPADLIST(cv) = padlist)
# define newPADNAMEpvn(p,n) S_newPADNAMEpvn(aTHX_ p,n)
static PADNAME *S_newPADNAMEpvn(pTHX_ const char *pv, STRLEN n)
{
PADNAME *pn = newSVpvn(pv, n);
/* PADNAMEs need to be at least SVt_PVNV in order to store the COP_SEQ_*
* fields */
sv_upgrade(pn, SVt_PVNV);
return pn;
}
# define PadnameREFCNT_dec(pn) SvREFCNT_dec(pn)
#endif
#ifndef av_count
# define av_count(av) (AvFILL(av) + 1)
#endif
#ifndef av_fetch_simple
# define av_fetch_simple(av, idx, lval) av_fetch(av, idx, lval)
#endif
#ifndef av_push_simple
# define av_push_simple(av, sv) av_push(av, sv)
#endif
#ifndef av_store_simple
# define av_store_simple(av, key, sv) av_store(av, key, sv)
#endif
#ifndef av_top_index
# define av_top_index(av) AvFILL(av)
#endif
#ifndef block_end
# define block_end(a,b) Perl_block_end(aTHX_ a,b)
#endif
#ifndef block_start
# define block_start(a) Perl_block_start(aTHX_ a)
#endif
#ifndef cophh_exists_pvs
# define cophh_exists_pvs(a,b,c) cBOOL(cophh_fetch_pvs(a,b,c))
#endif
#ifndef cv_clone
# define cv_clone(a) Perl_cv_clone(aTHX_ a)
#endif
#ifndef intro_my
# define intro_my() Perl_intro_my(aTHX)
#endif
#ifndef pad_alloc
# define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
#endif
#ifndef CX_CUR
# define CX_CUR() (&cxstack[cxstack_ix])
#endif
#if HAVE_PERL_VERSION(5, 24, 0)
# define OLDSAVEIX(cx) (cx->blk_oldsaveix)
#else
# define OLDSAVEIX(cx) (PL_scopestack[cx->blk_oldscopesp-1])
#endif
#ifndef OpSIBLING
# define OpSIBLING(op) ((op)->op_sibling)
#endif
#ifndef OpHAS_SIBLING
# define OpHAS_SIBLING(op) (cBOOL(OpSIBLING(op)))
#endif
#ifndef OpMORESIB_set
# define OpMORESIB_set(op,sib) ((op)->op_sibling = (sib))
#endif
#ifndef OpLASTSIB_set
/* older perls don't need to store this at all */
# define OpLASTSIB_set(op,parent) ((op)->op_sibling = NULL)
#endif
#ifndef op_convert_list
# define op_convert_list(type, flags, o) S_op_convert_list(aTHX_ type, flags, o)
static OP *S_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
{
/* A minimal recreation just for our purposes */
assert(
/* A hardcoded list of the optypes we know this will work for */
type == OP_ENTERSUB ||
type == OP_JOIN ||
type == OP_PUSH ||
0);
o->op_type = type;
o->op_flags |= flags;
o->op_ppaddr = PL_ppaddr[type];
o = PL_check[type](aTHX_ o);
/* op_std_init() */
if(PL_opargs[type] & OA_RETSCALAR)
o = op_contextualize(o, G_SCALAR);
if(PL_opargs[type] & OA_TARGET && !o->op_targ)
o->op_targ = pad_alloc(type, SVs_PADTMP);
return o;
}
#endif
#ifndef newMETHOP_named
# define newMETHOP_named(type, flags, name) newSVOP(type, flags, name)
#endif
#ifndef PARENT_PAD_INDEX_set
# if HAVE_PERL_VERSION(5, 22, 0)
# define PARENT_PAD_INDEX_set(pn,val) (PARENT_PAD_INDEX(pn) = val)
# else
/* stolen from perl-5.20.0's pad.c */
# define PARENT_PAD_INDEX_set(sv,val) \
STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
# endif
#endif
/* On Perl 5.14 this had a different name */
#ifndef pad_add_name_pvn
#define pad_add_name_pvn(name, len, flags, typestash, ourstash) MY_pad_add_name(aTHX_ name, len, flags, typestash, ourstash)
static PADOFFSET MY_pad_add_name(pTHX_ const char *name, STRLEN len, U32 flags, HV *typestash, HV *ourstash)
{
/* perl 5.14's Perl_pad_add_name requires a NUL-terminated name */
SV *namesv = sv_2mortal(newSVpvn(name, len));
return Perl_pad_add_name(aTHX_ SvPV_nolen(namesv), SvCUR(namesv), flags, typestash, ourstash);
}
#endif
#if !HAVE_PERL_VERSION(5, 26, 0)
# define isIDFIRST_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDFIRST_utf8(s))
# define isIDCONT_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDCONT_utf8(s))
#endif
#ifndef CXp_EVALBLOCK
/* before perl 5.34 this was called CXp_TRYBLOCK */
# define CXp_EVALBLOCK CXp_TRYBLOCK
#endif
#if !HAVE_PERL_VERSION(5, 26, 0)
# define sv_set_undef(sv) sv_setsv(sv, &PL_sv_undef)
#endif
#ifndef newAVav
# define newAVav(av) S_newAVav(aTHX_ av)
static AV *S_newAVav(pTHX_ AV *av)
{
AV *ret = newAV();
U32 count = av_count(av);
U32 i;
for(i = 0; i < count; i++)
av_push(ret, newSVsv(AvARRAY(av)[i]));
return ret;
}
#endif
#ifndef newAV_alloc_x
# define newAV_alloc_x(n) S_newAV_alloc_x(aTHX_ n)
static AV *S_newAV_alloc_x(pTHX_ SSize_t n)
{
AV *av = newAV();
av_extend(av, n-1);
return av;
}
#endif
#if !defined(sv_derived_from_hv) && HAVE_PERL_VERSION(5, 16, 0)
# define sv_derived_from_hv(sv, hv) MY_sv_derived_from_hv(aTHX_ sv, hv)
static bool MY_sv_derived_from_hv(pTHX_ SV *sv, HV *hv)
{
char *hvname = HvNAME(hv);
if(!hvname)
return FALSE;
return sv_derived_from_pvn(sv, hvname, HvNAMELEN(hv), HvNAMEUTF8(hv) ? SVf_UTF8 : 0);
}
#endif
#ifndef xV_FROM_REF
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define xV_FROM_REF(XV, ref) \
({ SV *_ref = ref; assert(SvROK(_ref)); assert(SvTYPE(SvRV(_ref)) == SVt_PV ## XV); (XV *)(SvRV(_ref)); })
# else
# define xV_FROM_REF(XV, ref) ((XV *)SvRV(ref))
# endif
# define AV_FROM_REF(ref) xV_FROM_REF(AV, ref)
# define CV_FROM_REF(ref) xV_FROM_REF(CV, ref)
# define HV_FROM_REF(ref) xV_FROM_REF(HV, ref)
#endif
#ifndef newPADxVOP
# define newPADxVOP(type, flags, padix) S_newPADxVOP(aTHX_ type, flags, padix)
static OP *S_newPADxVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix)
{
OP *op = newOP(type, flags);
op->op_targ = padix;
return op;
}
#endif
Data-Checks-0.10/hax/sv_numcmp.c.inc000444001750001750 346414660677075 16113 0ustar00leoleo000000000000/* vi: set ft=c : */
/* We'd like to call Perl_do_ncmp, except that isn't an exported API function
* Here's a near-copy of it */
#define sv_numcmp(left, right) S_sv_numcmp(aTHX_ left, right)
static int S_sv_numcmp(pTHX_ SV *left, SV *right)
{
#ifndef HAVE_BOOL_SvIV_please_nomg
/* Before perl 5.18, SvIV_please_nomg() was void-returning */
SvIV_please_nomg(left);
SvIV_please_nomg(right);
#endif
if(
#ifdef HAVE_BOOL_SvIV_please_nomg
SvIV_please_nomg(right) && SvIV_please_nomg(left)
#else
SvIOK(left) && SvIOK(right)
#endif
) {
/* Compare as integers */
switch((SvUOK(left) ? 1 : 0) | (SvUOK(right) ? 2 : 0)) {
case 0: /* IV == IV */
{
const IV liv = SvIVX(left), riv = SvIVX(right);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 1: /* UV == IV */
{
const IV riv = SvUVX(right);
if(riv < 0)
return 1;
const IV liv = SvIVX(left);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 2: /* IV == UV */
{
const IV liv = SvUVX(left);
if(liv < 0)
return -1;
const IV riv = SvIVX(right);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 3: /* UV == UV */
{
const UV luv = SvUVX(left), ruv = SvUVX(right);
if (luv < ruv) return -1;
else if(luv > ruv) return 1;
else return 0;
}
}
}
else {
/* Compare NVs */
NV const rnv = SvNV_nomg(right);
NV const lnv = SvNV_nomg(left);
if (lnv < rnv) return -1;
else if(lnv > rnv) return 1;
else return 0;
}
}
Data-Checks-0.10/hax/sv_regexp_match.c.inc000444001750001750 127214660677075 17255 0ustar00leoleo000000000000/* vi: set ft=c : */
#define sv_regexp_match(sv, rx) S_sv_regexp_match(aTHX_ sv, rx)
static bool S_sv_regexp_match(pTHX_ SV *sv, REGEXP *rx)
{
STRLEN len;
/* These don't get modified, but CALLREGEXEC() doesn't take consts. */
char *strbeg = SvPV(sv, len);
char *strend = strbeg + len;
STRLEN minlen = RX_MINLEN(rx);
if(minlen && len < minlen)
/* string is already shorter than the shortest possible match */
return false;
/* Entirely unclear from docs what data or flags should be but in practice
* it turns out that NULL/0 seems to work fine.
* minend can just be 1.
*/
I32 ret = CALLREGEXEC(rx, strbeg, strend, strbeg, 1, sv, NULL, 0);
return (ret != 0);
}
Data-Checks-0.10/hax/sv_streq.c.inc000444001750001750 122114660677075 15737 0ustar00leoleo000000000000/* vi: set ft=c : */
#ifndef sv_streq_flags
# define sv_streq_flags(lhs, rhs, flags) S_sv_streq_flags(aTHX_ lhs, rhs, flags)
static bool S_sv_streq_flags(pTHX_ SV *lhs, SV *rhs, U32 flags)
{
if(flags & SV_GMAGIC) {
if(lhs)
SvGETMAGIC(lhs);
if(rhs)
SvGETMAGIC(rhs);
}
if(!lhs)
lhs = &PL_sv_undef;
if(!rhs)
rhs = &PL_sv_undef;
if(!(flags & SV_SKIP_OVERLOAD) && (SvAMAGIC(lhs) || SvAMAGIC(rhs))) {
SV *ret = amagic_call(lhs, rhs, seq_amg, 0);
if(ret)
return SvTRUE(ret);
}
return sv_eq_flags(lhs, rhs, 0);
}
#endif
#ifndef sv_streq
# define sv_streq(lhs, rhs) sv_streq_flags(lhs, rhs, 0)
#endif
Data-Checks-0.10/inc000755001750001750 014660677075 13015 5ustar00leoleo000000000000Data-Checks-0.10/inc/Module000755001750001750 014660677075 14242 5ustar00leoleo000000000000Data-Checks-0.10/inc/Module/Build000755001750001750 014660677075 15301 5ustar00leoleo000000000000Data-Checks-0.10/inc/Module/Build/with000755001750001750 014660677075 16254 5ustar00leoleo000000000000Data-Checks-0.10/inc/Module/Build/with/XSTests.pm000444001750001750 174514660677075 20333 0ustar00leoleo000000000000package Module::Build::with::XSTests;
use v5.22;
use warnings;
use base qw( Module::Build );
# Stolen and edited from Module::Build::Base::_infer_xs_spec
sub _infer_xs_spec
{
my $self = shift;
my ( $file ) = @_;
my $spec = $self->SUPER::_infer_xs_spec( $file );
if( $file =~ m{^t/} ) {
$spec->{$_} = File::Spec->catdir( "t", $spec->{$_} )
for qw( archdir bs_file lib_file );
}
return $spec;
}
# Various bits stolen from Module::Build::Base::
# process_xs_files()
sub ACTION_testlib
{
my $self = shift;
my $testxsfiles = $self->_find_file_by_type('xs', 't');
foreach my $from ( sort keys %$testxsfiles ) {
my $to = $testxsfiles->{$from};
if( $to ne $from ) {
$self->add_to_cleanup( $to );
$self->copy_if_modified( from => $from, to => $to );
}
$self->process_xs( $to );
}
}
sub ACTION_test
{
my $self = shift;
$self->depends_on( "testlib" );
$self->SUPER::ACTION_test( @_ );
}
0x55AA;
Data-Checks-0.10/include000755001750001750 014660677075 13667 5ustar00leoleo000000000000Data-Checks-0.10/include/constraints.h000444001750001750 132314660677075 16543 0ustar00leoleo000000000000#ifndef __CONSTRAINTS_H__
#define __CONSTRAINTS_H__
struct Constraint;
typedef bool ConstraintFunc(pTHX_ struct Constraint *c, SV *value);
struct Constraint
{
ConstraintFunc *func;
int flags; /* avoids needing an entire SV just for a few numeric flag bits */
size_t n;
SV *args[0];
};
#define stringify_constraint(c) DataChecks_stringify_constraint(aTHX_ c)
#define stringify_constraint_sv(csv) DataChecks_stringify_constraint(aTHX_ (struct Constraint *)SvPVX(csv))
SV *DataChecks_stringify_constraint(pTHX_ struct Constraint *c);
#define extract_constraint(sv) DataChecks_extract_constraint(aTHX_ sv)
SV *DataChecks_extract_constraint(pTHX_ SV *sv);
void boot_Data_Checks__constraints(pTHX);
#endif
Data-Checks-0.10/lib000755001750001750 014660677075 13012 5ustar00leoleo000000000000Data-Checks-0.10/lib/Data000755001750001750 014660677075 13663 5ustar00leoleo000000000000Data-Checks-0.10/lib/Data/Checks.pm000444001750001750 3072414660677075 15604 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2024 -- leonerd@leonerd.org.uk
package Data::Checks 0.10;
use v5.22;
use warnings;
use Carp;
use builtin qw( export_lexically );
no warnings "experimental::builtin";
sub import
{
shift;
my @syms = @_;
# @EXPORT_OK is provided by XS code
foreach my $sym ( @syms ) {
grep { $sym eq $_ } our @EXPORT_OK or
croak "$sym is not exported by ".__PACKAGE__;
export_lexically( $sym => \&$sym );
}
}
require XSLoader;
XSLoader::load( __PACKAGE__, our $VERSION );
=head1 NAME
C - Value constraint checking
=head1 SYNOPSIS
With L:
=for highlighter perl
use v5.26;
use Sublike::Extended;
use Signature::Attribute::Checked;
use Data::Checks qw( Str );
extended sub greet ( $message :Checked(Str) ) {
say "Hello, $message";
}
greet( "world" ); # is fine
greet( undef ); # throws an exception
With L:
use v5.22;
use Object::Pad;
use Object::Pad::FieldAttr::Checked;
use Data::Checks qw( Str );
class Datum {
field $name :param :reader :Checked(Str);
}
my $x = Datum->new( name => "something" ); # is fine
my $y = Datum->new( name => undef ); # throws an exception
With L on Perl v5.38 or later:
use v5.38;
use Syntax::Operator::Is;
use Data::Checks qw( Num Object );
my $x = ...;
if($x is Num) {
say "x can be used as a number";
}
elsif($x is Object) {
say "x can be used as an object";
}
=head1 DESCRIPTION
This module provides functions that implement various value constraint
checking behaviours. These are the parts made visible by the
C