Algorithm-AM
view release on metacpan or search on metacpan
removed non-existent dependency that prevented installation
2.36 2014-02-07 16:24:26 America/Los_Angeles
remove given/when (which trigger 'experimental' warnings)
better handling of project files
line directives added to ginormous eval statement
add methods to Project for adding data and test items
use C99 datatypes in AM.xs to ensure correct bit sizes
2.35 2013-12-05 19:50:27 America/Los_Angeles
created Algorithm::AM::Project to handle all data file processing
- also checks size of data vectors!
- has lots of accessors and new error checking, including problems with number of variables!
caller's autoflush setting is no longer clobbered
lots more refactoring
removed use of 'given' and 'when', which are experimental and caused warnings and therefore failed tests
2.34 2013-09-03 22:39:22 America/Los_Angeles
Considerable refactoring of how arguments and variables are handled
- use object or data hash instead of automatic importing
- most of them renamed, and possible values have changed
- new tests for errors and warnings
2.33 2013-06-03 22:22:10 America/Los_Angeles
Changed chomp mechanism so Windows files can be used in testing on *nix
2.32 2013-05-30 14:37:09 America/Los_Angeles
Fixed package declarations in POD files, which prevented listing on metacpan
2.31 2013-05-15 15:22:32 America/Los_Angeles
First CPAN release.
Add other bigint helper methods into BigInt and test them, as well.
Instead of passing around the "activeVars" variable and skipping nulls if needed, it might make more sense to create an array containing all of the active indices, i.e. [0,1,2,4,6,7] if 3 and 5 are null and exclude nulls is on. This would make it eas...
do something better than just calling rand() for the probability/skip function.
Move the XS code to a different package so all of those variables can be stored in something private: pointers, itemcontextchainhead, etc. The work done on gangs could also be put into this package, since it requires special knowledge of the underlyi...
change active_features to be accepted at classification time
properly destroy project or AM object on error so that illegal state is not possible even if someone catches an error and tries to continue.
## Other TODOs:
-Figure out good project organization to allow dual builders (MB and EUMM)
-Create an AM old stuff branch
-Think about possibilities of other types of lattices (non-boolean)
## Documentation TODOs:
- Add pictures!
- Provide a glossary of terms including usage from ML and AM literature.
bin/analogize.pl view on Meta::CPAN
say "$count out of " . $test->size . " correct";
return;
}
sub _validate_args {
my %args = @_;
if($args{help}){
pod2usage(1);
}
my $errors = '';
if(!$args{exemplars} and !$args{project}){
$errors .= "Error: need either --exemplars or --project parameters\n";
}elsif(($args{exemplars} or $args{test}) and $args{project}){
$errors .= "Error: --project parameter cannot be used with --exempalrs or --test\n";
}
if(!defined $args{format}){
$errors .= "Error: missing --format parameter\n";
}elsif($args{format} !~ m/^(?:no)?commas$/){
$errors .=
"Error: --format parameter must be either 'commas' or 'nocommas'\n";
}
if($args{print}){
my %allowed =
map {$_ => 1} qw(
config_info
statistical_summary
analogical_set_summary
gang_summary
gang_detailed
);
for my $param (split ',', $args{print}){
if(!exists $allowed{$param}){
$errors .= "Error: unknown print parameter '$param'\n";
}
}
}
if($errors){
$errors .= 'use "analogize --help" for detailed usage information';
chomp $errors;
pod2usage($errors);
}
}
__END__
=pod
=encoding UTF-8
=head1 NAME
lib/Algorithm/AM/BigInt.pm view on Meta::CPAN
#pod
#pod This is an inexact double representation of the integer value.
#pod
#pod =item PV
#pod
#pod This is an exact string representation of the integer value.
#pod
#pod =back
#pod
#pod Operations on the floating-point representation will necessarily have a
#pod small amount of error, so exact calculation or comparison requires
#pod referencing the string field. The number field is still useful in
#pod printing reports; for example, using C<printf>, where precision can
#pod be specified.
#pod
#pod Currently, the only provided helper function is for comparison of
#pod two big integers.
#pod
#pod =head2 C<bigcmp>
#pod
#pod Compares two big integers, returning 1, 0, or -1 depending on whether
lib/Algorithm/AM/BigInt.pm view on Meta::CPAN
This is an inexact double representation of the integer value.
=item PV
This is an exact string representation of the integer value.
=back
Operations on the floating-point representation will necessarily have a
small amount of error, so exact calculation or comparison requires
referencing the string field. The number field is still useful in
printing reports; for example, using C<printf>, where precision can
be specified.
Currently, the only provided helper function is for comparison of
two big integers.
=head2 C<bigcmp>
Compares two big integers, returning 1, 0, or -1 depending on whether
lib/Algorithm/AM/DataSet.pm view on Meta::CPAN
my %final_opts;
if(!defined $opts{cardinality}){
croak q{Failed to provide 'cardinality' parameter};
}
$final_opts{cardinality} = $opts{cardinality};
delete $opts{cardinality};
if(keys %opts){
# sort the keys in the error message to make testing possible
croak 'Unknown parameters in DataSet constructor: ' .
(join ', ', sort keys %opts);
}
return \%final_opts;
}
# initialize internal state
sub _init {
my ($self) = @_;
lib/Algorithm/AM/DataSet.pm view on Meta::CPAN
}
my $dataset = __PACKAGE__->new(cardinality => $item->cardinality);
$dataset->add_item($item);
while($item = $reader->()){
$dataset->add_item($item);
}
return $dataset;
}
# return a sub that returns one Item per call from the given FH,
# and returns undef once the file is done being read. Throws errors
# on bad file contents.
# Input is file (Path::Tiny), string representing unknown class,
# string representing null feature, field separator (class,
# features, comment) and feature separator
sub _read_data_sub {
my ($data_file, $unknown, $null,
$field_sep, $feature_sep) = @_;
my $data_fh = $data_file->openr_utf8;
my $line_num = 0;
return sub {
--version show version
--patch=file write one patch file with changes
--copy=suffix write changed copies with suffix
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
--strip strip all script and doc functionality
from ppport.h
--list-provided list provided API
--list-unsupported list API that isn't supported all the way
=head2 --cplusplus
Usually, F<ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
=head2 --nohints
Don't output any hints. Hints often contain useful portability
notes. Warnings will still be displayed.
FEATURE_STATE_IS_ENABLED|5.015007||Viu
FEATURE___SUB___BIT|5.031006||Viu
FEATURE___SUB___IS_ENABLED|5.015007||Viu
FEATURE_SWITCH_BIT|5.031006||Viu
FEATURE_SWITCH_IS_ENABLED|5.015007||Viu
FEATURE_UNICODE_BIT|5.031006||Viu
FEATURE_UNICODE_IS_ENABLED|5.015007||Viu
FEATURE_UNIEVAL_BIT|5.031006||Viu
FEATURE_UNIEVAL_IS_ENABLED|5.015007||Viu
feof|5.003007||Viu
ferror|5.003007||Viu
FETCHFEATUREBITSHH|5.031006||Viu
F_exp_amg|5.004000||Viu
FF_0DECIMAL|5.007001||Viu
FF_BLANK|5.003007||Viu
FF_CHECKCHOP|5.003007||Viu
FF_CHECKNL|5.003007||Viu
FF_CHOP|5.003007||Viu
FF_DECIMAL|5.003007||Viu
FF_END|5.003007||Viu
FF_FETCH|5.003007||Viu
my_nl_langinfo|5.027006||Vniu
my_pclose|5.003007|5.003007|u
my_popen|5.003007|5.003007|u
my_popen_list|5.007001|5.007001|u
my_setenv|5.003007|5.003007|
my_snprintf|5.009004|5.003007|pvn
my_socketpair|5.007003|5.007003|nu
my_sprintf|5.009003|5.003007|pdn
my_stat|5.013003||Viu
my_stat_flags|5.013003||cViu
my_strerror|5.021001||Viu
my_strftime|5.007002|5.007002|
my_strlcat|5.009004|5.003007|pn
my_strlcpy|5.009004|5.003007|pn
my_strnlen|5.027006|5.003007|pn
my_strtod|5.029010|5.029010|n
my_unexec|5.003007||Viu
my_vsnprintf|5.009004|5.009004|n
N0|5.029001||Viu
N10|5.029001||Viu
N11|5.029001||Viu
PerlEnv_get_childenv|5.006000||Viu
PerlEnv_get_child_IO|5.006000||Viu
PerlEnv_getenv|5.005000||Viu
PerlEnv_getenv_len|5.006000||Viu
PerlEnv_lib_path|5.005000||Viu
PerlEnv_os_id|5.006000||Viu
PerlEnv_putenv|5.005000||Viu
PerlEnv_sitelib_path|5.005000||Viu
PerlEnv_uname|5.005004||Viu
PerlEnv_vendorlib_path|5.006000||Viu
Perl_error_log|5.006000||Viu
Perl_eval_pv||5.003007|onu
Perl_eval_sv||5.003007|onu
PERL_EXIT_ABORT|5.019003|5.019003|
PERL_EXIT_DESTRUCT_END|5.007003|5.007003|
PERL_EXIT_EXPECTED|5.006000|5.006000|
PERL_EXIT_WARN|5.019003|5.019003|
Perl_exp|5.006000||Viu
PERL_FEATURE_H|5.029006||Viu
PERL_FILE_IS_ABSOLUTE|5.006000||Viu
PERL_FILTER_EXISTS|5.009005||Viu
PerlIO_binmode|5.007001|5.007001|
PERLIOBUF_DEFAULT_BUFSIZ|5.013007||Viu
PerlIO_canset_cnt|5.003007|5.003007|n
PerlIO_clearerr|5.007003|5.007003|
PerlIO_close|5.007003|5.007003|
PerlIO_context_layers|5.009004|5.009004|u
PerlIO_debug|5.007001|5.007001|
PERLIO_DUP_CLONE|5.007003||Viu
PERLIO_DUP_FD|5.007003||Viu
PerlIO_eof|5.007003|5.007003|
PerlIO_error|5.007003|5.007003|
PerlIO_exportFILE|5.003007|5.003007|n
PERLIO_F_APPEND|5.007001||Viu
PerlIO_fast_gets|5.003007|5.003007|n
PERLIO_F_CANREAD|5.007001||Viu
PERLIO_F_CANWRITE|5.007001||Viu
PERLIO_F_CLEARED|5.013008||Viu
PERLIO_F_CRLF|5.007001||Viu
PerlIO_fdopen|5.003007|5.003007|n
PERLIO_F_EOF|5.007001||Viu
PERLIO_F_ERROR|5.007001||Viu
PERLSI_MULTICALL|5.023000||Viu
Perl_sin|5.006000||Viu
Perl_sinh|5.021004||Viu
PerlSIO_canset_cnt|5.007001||Viu
PerlSIO_clearerr|5.007001||Viu
PerlSIO_fast_gets|5.007001||Viu
PerlSIO_fclose|5.007001||Viu
PerlSIO_fdopen|5.007001||Viu
PerlSIO_fdupopen|5.007001||Viu
PerlSIO_feof|5.007001||Viu
PerlSIO_ferror|5.007001||Viu
PerlSIO_fflush|5.007001||Viu
PerlSIO_fgetc|5.007001||Viu
PerlSIO_fgetpos|5.007001||Viu
PerlSIO_fgets|5.007001||Viu
PerlSIO_fileno|5.007001||Viu
PerlSIO_fopen|5.007001||Viu
PerlSIO_fputc|5.007001||Viu
PerlSIO_fputs|5.007001||Viu
PerlSIO_fread|5.007001||Viu
PerlSIO_freopen|5.007001||Viu
PL_dumpindent|5.006000||Viu
PL_dump_re_max_len|5.023008||Viu
PL_efloatbuf|5.006000||Viu
PL_efloatsize|5.006000||Viu
PL_E_FORMAT_PRECISION|5.029000||Viu
PL_encoding|5.007003||Viu
PL_endav|5.005000||Viu
PL_Env|5.006000||Viu
PL_envgv|5.005000||Viu
PL_errgv|5.004005|5.003007|p
PL_error_count||5.003007|ponu
PL_errors|5.006000||Viu
PL_e_script|5.005000||Viu
PL_eval_root|5.005000||Viu
PL_evalseq|5.005000||Viu
PL_eval_start|5.005000||Viu
PL_exit_flags|5.006000|5.006000|
PL_exitlist|5.005000||Viu
PL_exitlistlen|5.005000||Viu
PL_expect||5.003007|ponu
PL_fdpid|5.005000||Viu
PL_filemode|5.005000||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
pv_pretty|5.009004|5.003007|p
pv_uni_display|5.007003|5.007003|
pWARN_ALL|5.006000||Viu
pWARN_NONE|5.006000||Viu
pWARN_STD|5.006000||Viu
PWGECOS|5.004005|5.004005|Vn
PWPASSWD|5.005000|5.005000|Vn
qerror|5.006000||cViu
QR_PAT_MODS|5.009005||Viu
QUAD_IS_INT|5.006000|5.006000|Vn
QUAD_IS___INT64|5.015003|5.015003|Vn
QUAD_IS_INT64_T|5.006000|5.006000|Vn
QUAD_IS_LONG|5.006000|5.006000|Vn
QUAD_IS_LONG_LONG|5.006000|5.006000|Vn
QUADKIND|5.006000|5.006000|Vn
quadmath_format_needed|5.021004||Vni
quadmath_format_valid|5.031007||Vni
Quad_t|5.003007|5.003007|Vn
STMT_END|5.003007|5.003007|pV
STMT_START|5.003007|5.003007|pV
STOREFEATUREBITSHH|5.031006||Viu
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING|5.021010|5.021010|
STORE_LC_NUMERIC_SET_STANDARD|5.027009||pViu
STORE_LC_NUMERIC_SET_TO_NEEDED|5.021010|5.021010|
STORE_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
STORE_NUMERIC_SET_STANDARD|5.027009||pViu
strBEGINs|5.027006||Viu
strEQ|5.003007|5.003007|
Strerror|5.003007||Viu
strerror|5.009000||Viu
STRERROR_R_PROTO|5.008000|5.008000|Vn
strGE|5.003007|5.003007|
strGT|5.003007|5.003007|
STRING|5.006000||Viu
STRINGIFY|5.003007|5.003007|Vn
STRINGl|5.031005||Viu
STRINGs|5.031005||Viu
strip_return|5.009003||Viu
strLE|5.003007|5.003007|
STR_LEN|5.006000||Viu
UTF8_IS_SUPER|5.023002|5.023002|
UTF8_IS_SURROGATE|5.023002|5.023002|
utf8_length|5.007001|5.007001|
UTF8_MAXBYTES|5.009002|5.006000|p
UTF8_MAXBYTES_CASE|5.009002|5.003007|p
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
utf8_mg_pos_cache_update|5.009004||Viu
utf8n_to_uvchr|5.007001|5.007001|n
utf8n_to_uvchr_error|5.025006|5.025006|n
utf8n_to_uvchr_msgs|5.027009|5.027009|n
_utf8n_to_uvchr_msgs_helper|5.029001||cVnu
utf8n_to_uvuni|5.007001||dcV
UTF8_SAFE_SKIP|5.029009|5.006000|p
UTF8SKIP|5.006000|5.006000|
UTF8_SKIP|5.023002|5.006000|p
utf8_to_bytes|5.006001|5.006001|x
utf8_to_uvchr|5.007001|5.006001|pd
utf8_to_uvchr_buf|5.015009|5.006001|p
utf8_to_uvchr_buf_helper|5.031004||cVu
WIDEST_UTYPE|5.015004|5.003007|p
WIFEXITED|5.008001||Viu
WIFSIGNALED|5.008001||Viu
WIFSTOPPED|5.008001||Viu
win32_croak_not_implemented|5.017006||Vniu
WIN32SCK_IS_STDSCK|5.007001||Viu
win32_setlocale|5.027006||Viu
withinCOUNT|5.031004||Viu
WITH_LC_NUMERIC_SET_TO_NEEDED|5.031003|5.031003|
WITH_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
with_queued_errors|5.013001||Viu
WNOHANG|5.008001||Viu
wrap_keyword_plugin|5.027006|5.027006|x
wrap_op_checker|5.015008|5.015008|
write|5.005000||Viu
write_to_stderr|5.008001||Viu
WSTOPSIG|5.008001||Viu
WTERMSIG|5.008001||Viu
WUNTRACED|5.008001||Viu
XCPT_CATCH|5.009002|5.003007|p
XCPT_RETHROW|5.009002|5.003007|p
XS_VERSION|5.003007|5.003007|
XS_VERSION_BOOTCHECK|5.003007|5.003007|
xs_version_bootcheck|||iu
XTENDED_PAT_MOD|5.009005||Viu
xuv_uv|5.009003||Viu
YESEXPR|5.027010||Viu
YESSTR|5.027010||Viu
YIELD|5.005000||Viu
YYDEBUG|5.025006||Viu
YYEMPTY|5.009005||Viu
yyerror|5.003007||Viu
yyerror_pv|5.016000||Viu
yyerror_pvn|5.016000||Viu
yylex|5.003007||cViu
yyparse|5.003007||Viu
yyquit|5.025010||Viu
YYSTYPE_IS_DECLARED|5.009001||Viu
YYSTYPE_IS_TRIVIAL|5.009001||Viu
YYTOKENTYPE|5.009001||Viu
yyunlex|5.013005||Viu
yywarn|5.003007||Viu
ZAPHOD32_FINALIZE|5.027001||Viu
ZAPHOD32_MIX|5.027001||Viu
}
my $s = $warnings != 1 ? 's' : '';
my $warn = $warnings ? " ($warnings warning$s)" : '';
info("Analysis completed$warn");
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
mydiff(\*PATCH, $filename, $c);
}
else {
fallback:
info("Suggested changes:");
if (!defined $diff) {
$diff = run_diff('diff -u', $file, $str);
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
$diff .= $_;
}
close F;
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
#endif
#ifdef PERL_VERSION_MINOR
# define D_PPP_MINOR PERL_VERSION_MINOR
#elif defined(PERL_VERSION)
# define D_PPP_MINOR PERL_VERSION
#elif defined(PATCHLEVEL)
# define D_PPP_MINOR PATCHLEVEL
# define PERL_VERSION PATCHLEVEL /* back-compat */
#else
# error Could not find a source for PERL_VERSION_MINOR
#endif
#ifdef PERL_VERSION_PATCH
# define D_PPP_PATCH PERL_VERSION_PATCH
#elif defined(PERL_SUBVERSION)
# define D_PPP_PATCH PERL_SUBVERSION
#elif defined(SUBVERSION)
# define D_PPP_PATCH SUBVERSION
# define PERL_SUBVERSION SUBVERSION /* back-compat */
#else
# error Could not find a source for PERL_VERSION_PATCH
#endif
#if D_PPP_MAJOR < 5 || D_PPP_MAJOR == 6
# error Devel::PPPort works only on Perl 5, Perl 7, ...
#elif D_PPP_MAJOR != 5
/* Perl 7 and above: the old forms are deprecated, set up so that they
* assume Perl 5, and will make this look like 5.201.201.
*
* 201 is used so will be well above anything that would come from a 5
* series if we unexpectedly have to continue it, but still gives plenty of
* room, up to 255, of numbers that will fit into a byte in case there is
* something else unforeseen */
# undef PERL_REVISION
# undef PERL_VERSION
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
# define PL_linestr D_PPP_my_PL_parser_var(linestr)
# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
# define PL_bufend D_PPP_my_PL_parser_var(bufend)
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
# define PL_parser ((void *) 1)
#endif
#if (PERL_BCDVERSION <= 0x5003022)
(((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))
#endif
#ifndef inRANGE
# define inRANGE(c, l, u) \
( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \
: (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \
: (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
#endif
/* The '| 0' part ensures a compiler error if c is not integer (like e.g., a
* pointer) */
#undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */
#ifndef FITS_IN_8_BITS
# define FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \
|| !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF))
#endif
/* Create the macro for "is'macro'_utf8_safe(s, e)". For code points below
* 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
* point. That is so that it can automatically get the bug fixes done in this
( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
: ( 0x42 == ((const U8*)s)[1] ) ? \
( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \
: ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
: 0 ) \
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isCNTRL_utf8_safe
# define isCNTRL_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
#endif
#ifndef isDIGIT_utf8_safe
# define isDIGIT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT)
#endif
#ifndef isGRAPH_utf8_safe
# define isXDIGIT_utf8_safe(s,e) \
( ( LIKELY((e) > (s)) ) ? \
( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
: ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\
( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\
: ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isALPHA_LC_utf8_safe
# define isALPHA_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHA)
#endif
# ifdef isALPHANUMERIC_utf8
#ifndef isALPHANUMERIC_LC_utf8_safe
# define isALPHANUMERIC_LC_utf8_safe(s,e) \
D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHANUMERIC)
#endif
# define UVof "lo"
# define UVxf "lx"
# define UVXf "lX"
# elif IVSIZE == INTSIZE
# define IVdf "d"
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
/* Not very likely, but let's try anyway. */
# define NVef PERL_PRIeldbl
# define NVff PERL_PRIfldbl
# define NVgf PERL_PRIgldbl
# ifdef eval_sv
# undef eval_sv
# endif
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define eval_sv(sv, flags) ({ I32 _flags = (flags); I32 _ret = Perl_eval_sv(aTHX_ sv, (_flags & ~G_RETHROW)); D_PPP_CROAK_IF_ERROR(_flags & G_RETHROW); _ret; })
# else
# define eval_sv(sv, flags) ((PL_na = Perl_eval_sv(aTHX_ sv, ((flags) & ~G_RETHROW))), D_PPP_CROAK_IF_ERROR((flags) & G_RETHROW), (I32)PL_na)
# endif
#endif
/* Older Perl versions have broken croak_on_error=1 */
#if (PERL_BCDVERSION < 0x5031002)
# ifdef eval_pv
# undef eval_pv
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define eval_pv(p, croak_on_error) ({ SV *_sv = Perl_eval_pv(aTHX_ p, 0); D_PPP_CROAK_IF_ERROR(croak_on_error); _sv; })
# else
# define eval_pv(p, croak_on_error) ((PL_Sv = Perl_eval_pv(aTHX_ p, 0)), D_PPP_CROAK_IF_ERROR(croak_on_error), PL_Sv)
# endif
# endif
#endif
/* This is backport for Perl 5.3.97d and older which do not provide perl_eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
static
#else
extern SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
#endif
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
SV*
DPPP_(my_eval_pv)(const char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
D_PPP_CROAK_IF_ERROR(croak_on_error);
return sv;
}
#endif
#endif
#if ! defined(vload_module) && defined(start_subparse)
#if defined(NEED_vload_module)
static void DPPP_(my_vload_module)(U32 flags, SV * name, SV * ver, va_list * args);
#elif '^' == 176
#ifndef BOM_UTF8
# define BOM_UTF8 "\xDD\x72\x65\x72"
#endif
#ifndef REPLACEMENT_CHARACTER_UTF8
# define REPLACEMENT_CHARACTER_UTF8 "\xDD\x72\x72\x70"
#endif
#else
# error Unknown character set
#endif
#if (PERL_BCDVERSION < 0x5031004)
/* Versions prior to this accepted things that are now considered
* malformations, and didn't return -1 on error with warnings enabled
* */
# undef utf8_to_uvchr_buf
#endif
/* This implementation brings modern, generally more restricted standards to
* utf8_to_uvchr_buf. Some of these are security related, and clearly must
* be done. But its arguable that the others need not, and hence should not.
* The reason they're here is that a module that intends to play with the
* latest perls should be able to work the same in all releases. An example is
* that perl no longer accepts any UV for a code point, but limits them to
#if (PERL_BCDVERSION >= 0x5006001) && ! defined(utf8_to_uvchr_buf)
/* Choose which underlying implementation to use. At least one must be
* present or the perl is too early to handle this function */
# if defined(utf8n_to_uvchr) || defined(utf8_to_uvchr) || defined(utf8_to_uv)
# if defined(utf8n_to_uvchr) /* This is the preferred implementation */
# define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
# elif /* Must be at least 5.6.1 from #if above; \
If have both regular and _simple, regular has all args */ \
defined(utf8_to_uv) && defined(utf8_to_uv_simple)
# define D_PPP_utf8_to_uvchr_buf_callee utf8_to_uv
# elif defined(utf8_to_uvchr) /* The below won't work well on error input */
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uvchr((U8 *)(s), (retlen))
# else
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uv((U8 *)(s), (retlen))
# endif
# endif
# if defined(NEED_utf8_to_uvchr_buf)
static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
if (UNLIKELY(overflows)) {
if (! do_warnings) {
if (retlen) {
*retlen = D_PPP_MIN(*retlen, UTF8SKIP(s));
*retlen = D_PPP_MIN(*retlen, curlen);
}
return UNICODE_REPLACEMENT;
}
else {
/* We use the error message in use from 5.8-5.26 */
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Malformed UTF-8 character (overflow at 0x%" UVxf
", byte 0x%02x, after start byte 0x%02x)",
ret, *cur_s, *s);
if (retlen) {
*retlen = (STRLEN) -1;
}
return 0;
}
}
t/00-report-prereqs.t view on Meta::CPAN
my $static_prereqs = do './t/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
my $cpan_meta_error;
if ( $source && $HAS_CPAN_META
&& (my $meta = eval { CPAN::Meta->load_file($source) } )
) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
else {
$cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
t/00-report-prereqs.t view on Meta::CPAN
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
t/00-report-prereqs.t view on Meta::CPAN
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( $cpan_meta_error || @dep_errors ) {
diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
}
if ( $cpan_meta_error ) {
my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
}
if ( @dep_errors ) {
diag join("\n",
"\nThe following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass('Reported prereqs');
# vim: ts=4 sts=4 sw=4 et:
t/01-Item.t view on Meta::CPAN
plan tests => 13;
use Test::NoWarnings;
use Test::Exception;
use Algorithm::AM::DataSet::Item 'new_item';
test_constructor();
test_accessors();
# test that the constructor lives/dies when given valid/invalid parameters
sub test_constructor {
# The error should be thrown from Tiny.pm, the caller of DataSet,
# not from DataSet (tests that @CARP_NOT is working properly).
throws_ok {
Algorithm::AM::DataSet::Item->new();
} qr/Must provide 'features' parameter of type array ref.*Item.t/,
'constructor dies with missing features parameter';
throws_ok {
Algorithm::AM::DataSet::Item->new(features => 'hello');
} qr/Must provide 'features' parameter of type array ref.*Item.t/,
'constructor dies with incorrect features parameter';
t/02-DataSet.t view on Meta::CPAN
throws_ok {
$dataset->add_item(
features => ['3','1'],
class => 'c',
comment => 'comment'
);
} qr/Expected 3 features, but found 2 in 3 1 \(comment\)/,
'add_item fails with wrong number of features';
# The error should be thrown from Tiny.pm, the caller of DataSet,
# not from DataSet (tests that @CARP_NOT is working cardinalityperly).
throws_ok {
$dataset->add_item();
} qr/Must provide 'features' parameter of type array ref.*DataSet.t/,
'add_item fails with missing features parameter';
return;
}
# test the dataset_from_file function
sub test_dataset_from_file {
( run in 1.064 second using v1.01-cache-2.11-cpan-65fba6d93b7 )