AI-Pathfinding-AStar-Rectangle
view release on metacpan or search on metacpan
Benchmark/perl-vs-xs.pl view on Meta::CPAN
$map[WIDTH_X - 10][$_] = 0 for 10 .. WIDTH_Y - 5;
$map[10][$_] = 0 for 10 .. WIDTH_Y - 10;
$map[$_][WIDTH_Y - 10] = 0 for 10 .. WIDTH_X - 15;
$map[WIDTH_X - 15][$_] = 0 for 15 .. WIDTH_Y - 10;
$map[$_][15] = 0 for 15 .. WIDTH_X - 15;
for my $x (0 .. WIDTH_X - 1 )
{
for my $y (0 .. WIDTH_Y - 1 )
{
$m->set_passability($x, $y, $map[$x][$y]) ;
}
}
my ( $x_start, $y_start ) = ( WIDTH_X >> 1, WIDTH_Y >> 1 );
my ( $x_end, $y_end ) = ( 0, 0 );
my $t0 = [gettimeofday];
my $path;
my $r = timethese( -1, {Perl=>sub { astar( $x_start, $y_start, $x_end, $y_end ) },
XS=>sub {$m->astar($x_start, $y_start, $x_end, $y_end);}});
cmpthese($r);
Revision history for Perl extension AI::Pathfinding::AStar::Rectangle.
0.01 Wed Apr 1 13:54:05 2009
- original version; created by h2xs 1.23 with options
-A -n AI::Pathfinding::AStar::Rectangle
0.02 Wed Apr 1 13:54:05 2009
- Some bugfixes
0.16 September 25 23:34 2010
- foreach_xy foreach_xy_set implemented in PP.
- added clone.
- added test for this functions
0.17 September 26 14:34 2010
- begin_x, end_x, last_x, last_y
- added typemap.
- added test 06 for this functions
- remove some duplicated code
0.18 September 26 15:24 2010
README
Rectangle.xs
typemap
lib/AI/Pathfinding/AStar/Rectangle.pm
t/00-AI-Pathfinding-AStar-Rectangle.t
t/01-simple.t
t/02-passability.t
t/03-path-valid.t
t/04-astar.t
t/05-foreach.t
t/06-setstart.t
t/07-dastar.t
examples/snake_labirint.pl
Benchmark/perl-vs-xs.pl
META.yml Module meta-data (added by MakeMaker)
Rectangle.xs view on Meta::CPAN
#define croak_xs_usage(a,b) M_croak_xs_usage(aTHX_ a,b)
#else
#define croak_xs_usage M_croak_xs_usage
#endif
#endif
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */
#ifdef XMULTICALL
void
foreach_xy(self, block)
SV * self;
SV * block;
PROTOTYPE: $&
CODE:
Rectangle.xs view on Meta::CPAN
GvAV(PL_defgv) = argv;
}
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
if (items>2){
for(y =newmap->height-1 ; y>=0; --y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
else {
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
void
foreach_xy_set (self, block)
SV * self;
SV * block;
PROTOTYPE: $&
CODE:
{
dVAR; dMULTICALL;
pmap newmap;
int x,y;
GV *agv,*bgv,*gv;
HV *stash;
Rectangle.xs view on Meta::CPAN
SAVESPTR(GvSV(PL_defgv));
x1 = sv_newmortal();
y1 = sv_newmortal();
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
newmap->map[get_offset_abs(newmap, x, y)] = SvIV(*PL_stack_sp);
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
#endif
typedef struct map_like * pmap;
static int path_weigths[10]={50,14,10,14,10,50,10,14,10,14};
Rectangle.xs view on Meta::CPAN
return 0;
item = hv_fetch(opts, "width", 5, 0);
map->width = SvIV(*item);
item = hv_fetch(opts, "height", 6, 0);
map->height = SvIV(*item);
return 1;
}
void
inline init_move_offset(pmap map, int * const moves, int trim){
const int dx = 1;
const int dy = map->width + 2;
moves[0] = 0;
moves[5] = 0;
moves[1] = -dx + dy;
moves[2] = + dy;
moves[3] = +dx + dy;
moves[4] = -dx ;
moves[6] = +dx ;
moves[7] = -dx - dy;
Rectangle.xs view on Meta::CPAN
inline on_the_map(pmap newmap, int x, int y){
if (x< newmap->start_x ||y< newmap->start_y ){
return 0;
}
else if (x - newmap->start_x >= (int )newmap->width || y - newmap->start_y >= (int)newmap->height){
return 0;
}
return 1;
}
int
inline get_offset(pmap newmap, int x, int y){
return ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
}
int
inline get_offset_abs(pmap newmap, int x, int y){
return ( (y + 1)*(newmap->width+2) + (x + 1));
}
void
inline get_xy(pmap newmap, int offset, int *x,int *y){
*x = offset % ( newmap->width + 2) + newmap->start_x - 1;
*y = offset / ( newmap->width + 2) + newmap->start_y - 1;
}
MODULE = AI::Pathfinding::AStar::Rectangle PACKAGE = AI::Pathfinding::AStar::Rectangle
void
clone(pmap self)
PREINIT:
SV *string;
SV *clone;
PPCODE:
string = SvRV(ST(0));
clone = sv_newmortal();
sv_setsv( clone, string );
clone = newRV_inc( clone );
sv_bless( clone, SvSTASH( string ));
XPUSHs( sv_2mortal(clone));
void
clone_rect(pmap self, IV begin_x, IV begin_y, IV end_x, IV end_y)
PREINIT:
SV *clone;
Rectangle.xs view on Meta::CPAN
croak_xs_usage( cv, "left corner of rectangle is out of the map" );
if (!on_the_map( self, end_x, end_y ))
croak_xs_usage( cv, "rigth corner of rectangle is out of the map" );
if ( ! ( begin_x <= end_x ))
croak_xs_usage( cv, "attemp made to make zero width rectangle" );
if ( ! ( begin_y <= end_y ))
croak_xs_usage( cv, "attemp made to make zero height rectangle" );
clone = sv_newmortal();
sv_setpvn( clone, "", 0 );
re_map.width = end_x - begin_x + 1;
re_map.height = end_y - begin_y + 1;
map_size = sizeof(struct map_like)+(re_map.width + 2) * (re_map.height+2) *sizeof( char );
SvGROW( clone, map_size );
/* Initializing */
newmap = (pmap) SvPV_nolen( clone );
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
newmap->start_x = begin_x;
newmap->start_y = begin_y;
SvCUR_set(clone, map_size);
/*Copy passability */
if (1) {
int x, y;
for ( x = begin_x; x <= end_x ; ++x ){
for ( y = begin_y; y <= end_y; ++y ){
newmap->map[ get_offset( newmap, x, y )]=
self->map[ get_offset( self, x, y )];
}
}
};
/*Prepare for return full object */
clone = newRV_inc( clone );
sv_bless( clone, SvSTASH( SvRV(ST(0) )));
XPUSHs( sv_2mortal(clone));
Rectangle.xs view on Meta::CPAN
SvGROW(object, map_size = sizeof(struct map_like)+(re_map.width + 2) * (re_map.height+2));
newmap = (pmap) SvPV_nolen(object);
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
SvCUR_set(object, map_size);
RETVALUE = sv_2mortal( newRV_inc(object ));
sv_bless(RETVALUE, gv_stashpv( SvPV_nolen( self ), GV_ADD));
XPUSHs(RETVALUE);
void
start_x(pmap self, int newpos_x = 0 )
PPCODE:
if (items>1){
self->start_x = newpos_x;
XPUSHs(ST(0));
Rectangle.xs view on Meta::CPAN
mXPUSHi(self->start_x + (signed)self->width -1);
void
last_y(pmap newmap)
PPCODE:
mXPUSHi(newmap->start_y + (signed)newmap->height-1);
void
set_start_xy(pmap self, x, y)
int x;
int y;
PPCODE:
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", x, y);
self->start_x = x;
self->start_y = y;
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", self->width, self->height);
XPUSHs( ST(0) );
void
Rectangle.xs view on Meta::CPAN
INIT:
pmap newmap;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
XPUSHs( sv_2mortal(newSViv( newmap->map[offset])));
}
void
set_passability(self, x, y, value)
pmap self;
int x;
int y;
int value;
PPCODE:
if ( ! on_the_map( self, x, y )){
warn("x=%d,y=%d outside map", x, y);
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - self->start_y + 1)*(self->width+2) + (x-self->start_x+1));
self->map[offset] = value;
};
void
path_goto(self, x, y, path)
SV * self;
int x;
int y;
char *path;
INIT:
pmap newmap;
char * position;
int moves[10];
int gimme;
int offset;
int weigth;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
init_move_offset(newmap, moves, 0);
position = path;
weigth = 0;
while(*position){
if (*position < '0' || *position>'9'){
goto last_op;
};
offset+= moves[ *position - '0'];
weigth+= path_weigths[ *position - '0' ];
++position;
};
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
};
last_op:;
void
draw_path_xy( pmap newmap, int x, int y, char *path, int value )
PREINIT:
char *position;
int moves[10];
PPCODE:
if ( !on_the_map(newmap, x, y) ){
croak("start is outside the map");
}
else {
int offset = get_offset(newmap, x, y);
const int max_offset = get_offset_abs( newmap, newmap->width, newmap->height);
const int min_offset = get_offset_abs( newmap, 0, 0);
init_move_offset(newmap, moves,0);
newmap->map[offset] = value;
position = path;
while(*position){
if (*position < '0' || *position>'9'){
croak("bad path: illegal symbols");
};
offset+= moves[ *position - '0'];
if (offset > max_offset || offset < min_offset ||
offset % (int)(newmap->width + 2) == 0 ||
offset % (int)(newmap->width + 2) == (int) newmap->width + 1 ){
croak("path otside map");
}
newmap->map[offset] = value;
++position;
}
get_xy(newmap, offset, &x, &y);
mXPUSHi(x);
mXPUSHi(y);
}
void
is_path_valid(self, x, y, path)
SV * self;
int x;
int y;
char *path;
Rectangle.xs view on Meta::CPAN
int moves[10];
int gimme;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
int weigth = 0;
init_move_offset(newmap, moves,0);
position = path;
while(*position){
if (*position < '0' || *position>'9'){
XPUSHs(&PL_sv_no);
goto last_op;
};
offset+= moves[ *position - '0'];
if (! newmap->map[offset] ){
XPUSHs(&PL_sv_no);
goto last_op;
}
weigth+= path_weigths[ *position - '0' ];
++position;
}
// fprintf( stderr, "ok");
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
}
XPUSHs(&PL_sv_yes);
}
last_op:;
Rectangle.xs view on Meta::CPAN
dastar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int finish[5];
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if (!on_the_map(newmap, from_x, from_y) || !on_the_map(newmap, to_x, to_y)){
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size= (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
finish[0] = end_offset;
finish[1] = end_offset+1;
finish[2] = end_offset-1;
finish[3] = end_offset+newmap->width+2;
finish[4] = end_offset-newmap->width-2;
while( current != end_offset){
int i;
int g;
if ( 0
|| current == finish[1]
|| current == finish[2]
|| current == finish[3]
|| current == finish[4])
break;
layout[current].open = 0;
layout[current].closed = 1;
Rectangle.xs view on Meta::CPAN
STRLEN i;
SV* path;
U8 *path_pv;
STRLEN path_len;
path = sv_2mortal(newSVpvn("",0));
//
// 1
while(current != start_offset){
STRLEN i = layout[current].prev;
sv_catpvn_nomg(path, (char *) &path_char[i], (STRLEN) 1);
current -= moves[i];
};
// 2
// 3
//
path_pv = (U8*)SvPV( path, path_len);
for(i=0; i<path_len/2; ++i){
U8 x;
Rectangle.xs view on Meta::CPAN
astar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int index;
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if (!on_the_map(newmap, from_x, from_y) || !on_the_map(newmap, to_x, to_y)){
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size = (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
while( current != end_offset){
int i;
layout[current].open = 0;
layout[current].closed = 1;
for(i=0; i<8; ++i){
int nextpoint = current + moves[i];
int g;
if ( layout[nextpoint].closed || newmap->map[nextpoint] == 0 )
continue;
g = weigths[i] + layout[current].g;
if (layout[nextpoint].open ){
Rectangle.xs view on Meta::CPAN
}
{
STRLEN i;
SV* path;
U8 *path_pv;
STRLEN path_len;
path = sv_2mortal(newSVpvn("",0));
while(current != start_offset){
STRLEN i = layout[current].prev;
sv_catpvn_nomg(path, (char *)&path_char[i], (STRLEN)1);
current -= moves[i];
};
path_pv = (U8*)SvPV( path, path_len);
for(i=0; i<path_len/2; ++i){
U8 x;
x = path_pv[path_len-i-1];
path_pv[path_len - i - 1] = path_pv[i];
path_pv[ i ] = x;
examples/snake_labirint.pl view on Meta::CPAN
#~ use constant WIDTH_Y => 10;
use constant WIDTH_X => 64;
use constant WIDTH_Y => 32;
my $m = AI::Pathfinding::AStar::Rectangle->new({ width => WIDTH_X, height => WIDTH_Y });
use strict;
use warnings;
no warnings 'once';
#~ $m->foreach_xy_set( sub { $a < 12 && 1<$b && $b <9 } );
#~ $m->draw_path( 5, 5, '1666666888' );
#~ exit;
my @from = (0,0);
my @to = (WIDTH_X >> 1, WIDTH_Y >> 1);
my @map;
{
# Generate map
for my $x (0 .. WIDTH_X - 1 )
{
examples/snake_labirint.pl view on Meta::CPAN
$map[$_][WIDTH_Y - 5] = 0 for 5 .. WIDTH_X - 10;
$map[$_][10] = 0 for 10 .. WIDTH_X - 10;
$map[WIDTH_X - 10][$_] = 0 for 10 .. WIDTH_Y - 5;
$map[10][$_] = 0 for 10 .. WIDTH_Y - 10;
$map[$_][WIDTH_Y - 10] = 0 for 10 .. WIDTH_X - 15;
$map[WIDTH_X - 15][$_] = 0 for 15 .. WIDTH_Y - 10;
$map[$_][15] = 0 for 15 .. WIDTH_X - 15;
}
# copy map to map object
$m->foreach_xy_set( sub { $map[$a][$b] });
my ($path) = $m->astar(@to, @from);
sub swap(\@\@){
@_[0,1] = @_[1,0];;
}
#swap(@to, @from);
$m->draw_path(@to, $path);
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
&$sub();
}
};
}
sub foreach_xy_set{
my $self = shift;
my $sub = shift;
no strict 'refs';
local *a= *{ caller() . '::a' };
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
$self->set_passability( $a, $b, (scalar &$sub()) );
};
};
}
sub create_map($){
unshift @_, __PACKAGE__;
goto &new;
}
1 for ($a, $b); #suppress warnings
sub set_passability_string{
my $self = shift;
my $passability = shift;
die "Bad passabilitity param for set_passability_string" unless $self->width * $self->height == length( $passability );
$self->foreach_xy_set( sub { substr $passability, 0, 1, '' } );
}
sub get_passability_string{
my $self = shift;
my $buf = '';
$self->foreach_xy( sub { $buf.= chr( $_)} );
return $buf;
}
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
my $map = create_map({height=>10, width=>10});
#
# -or-
#
# $map = AI::Pathfinding::AStar::Rectangle->new({{height=>10, width=>10});
for my $x ($map->start_x..$map->last_x){
for my $y ($map->start_y..$map->last_y){
$map->set_passability($x, $y, $A[$x][$y]) # 1 - Can pass througth , 0 - Can't pass
}
}
my $path = $map->astar( $from_x, $from_y, $to_x, $to_y);
print $path, "\n"; # print path in presentation of "12346789" like keys at keyboard
=head1 DESCRIPTION
AI::Pathfinding::AStar::Rectangle provide abstraction for Rectangle map with AStar algoritm
=head1 OBJECT METHODS
=over 4
=item new { "width" => map_width, "height" => map_heigth }
Create AI::Pathfinding::AStar::Rectangle object. Object represent map with given height and width.
=item set_passability x, y, value # value: 1 - can pass through point, 0 - can't
Set passability for point(x,y)
=item get_passability (x,y)
Get passability for point
=item astar(from_x, from_y, to_x, to_y)
Search path from one point to other
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
Get map width
=item height()
Get map height
=item start_x(), start_y()
Get/Set coords for leftbottom-most point
=item set_start_xy( self, x, y)
Set coordinates of left-bootom point
=item last_x(), last_y()
Get coords for right-upper point
=item foreach_xy( BLOCK )
Call BLOCK for every point on map.
$map->foreach_xy( sub { $A[$a][$b] = $_ })
($a, $b, $_) (x, y, passability)
=item foreach_xy_set( sub { $A[$a][$b] });
set passability for every point at map.
BLOCK must return passability for point ($a, $b);
$a and $b must be global var not declared as my, our,
=item is_path_valid( start_x, start_y, path)
Check if path is valid path, all points from ( start_x, start_y ) to path end is passable
In list context return ( end_x, end_y, weigth, true or false )
=item path_goto( start_x, start_y, path)
In list context return
( end_x, end_y, weigth )
weight is sum of <diagonal (1379)> * 14 + <short path> * 10
=item draw_path( start_x, start_y, path)
print path to STDOUT
#!/usr/bin/perl
#
my $m = AI::Pathfinding::AStar::Rectangle->new({ width => 16, height => 8 });
$m->foreach_xy_set( sub { $a < 12 && 1<$b && $b <9 } );
$m->draw_path( 5, 5, '1666666888' );
Result:
# Steps: 10
# 00010203040506070809101112131415
# |#|#|#|#|#|#|#|#|#|#|#|#|#|#|#0
# |#|#|#|#|#|#|#|#|#|#|#|#|#|#|#1
# |_|_|_|_|_|_|_|_|_|_|_|_|#|#|#2
# |_|_|_|_|_|_|_|_|_|_|_|_|#|#|#3
automagially add a dot between the original filename and the
suffix. If you want the dot, you have to include it in the option
argument.
If neither C<--patch> or C<--copy> are given, the default is to
simply print the diffs for each file. This requires either
C<Text::Diff> or a C<diff> program to be installed.
=head2 --diff=I<program>
Manually set the diff program and options to use. The default
is to use C<Text::Diff>, when installed, and output unified
context diffs.
=head2 --compat-version=I<version>
Tell F<ppport.h> to check for compatibility with the given
Perl version. The default is to check for compatibility with Perl
version 5.003. You can use this option to reduce the output
of F<ppport.h> if you intend to be backward compatible only
down to a certain Perl version.
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
vload_module() NEED_vload_module NEED_vload_module_GLOBAL
vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
warner() NEED_warner NEED_warner_GLOBAL
To avoid namespace conflicts, you can change the namespace of the
explicitly exported functions / variables using the C<DPPP_NAMESPACE>
macro. Just C<#define> the macro before including C<ppport.h>:
#define DPPP_NAMESPACE MyOwnNamespace_
#include "ppport.h"
(index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
} )
: die "invalid spec: $_" } qw(
AvFILLp|5.004050||p
AvFILL|||
CLASS|||n
CPERLscope|5.005000||p
CX_CURPAD_SAVE|||
CX_CURPAD_SV|||
CopFILEAV|5.006000||p
CopFILEGV_set|5.006000||p
CopFILEGV|5.006000||p
CopFILESV|5.006000||p
CopFILE_set|5.006000||p
CopFILE|5.006000||p
CopSTASHPV_set|5.006000||p
CopSTASHPV|5.006000||p
CopSTASH_eq|5.006000||p
CopSTASH_set|5.006000||p
CopSTASH|5.006000||p
CopyD|5.009002||p
Copy|||
CvPADLIST|||
CvSTASH|||
CvWEAKOUTSIDE|||
DEFSV_set|5.011000||p
DEFSV|5.004050||p
END_EXTERN_C|5.005000||p
ENTER|||
ERRSV|5.004050||p
EXTEND|||
EXTERN_C|5.005000||p
F0convert|||n
FREETMPS|||
GIMME_V||5.004000|n
GIMME|||n
GetVars|||
GvSVn|5.009003||p
GvSV|||
Gv_AMupdate|||
HEf_SVKEY||5.004000|
HeHASH||5.004000|
HeKEY||5.004000|
HeKLEN||5.004000|
HePV||5.004000|
HeSVKEY_force||5.004000|
HeSVKEY_set||5.004000|
HeSVKEY||5.004000|
HeUTF8||5.011000|
HeVAL||5.004000|
HvNAMELEN_get|5.009003||p
HvNAME_get|5.009003||p
HvNAME|||
INT2PTR|5.006000||p
IN_LOCALE_COMPILETIME|5.007002||p
IN_LOCALE_RUNTIME|5.007002||p
IN_LOCALE|5.007002||p
Newx|5.009003||p
Nullav|||
Nullch|||
Nullcv|||
Nullhv|||
Nullsv|||
ORIGMARK|||
PAD_BASE_SV|||
PAD_CLONE_VARS|||
PAD_COMPNAME_FLAGS|||
PAD_COMPNAME_GEN_set|||
PAD_COMPNAME_GEN|||
PAD_COMPNAME_OURSTASH|||
PAD_COMPNAME_PV|||
PAD_COMPNAME_TYPE|||
PAD_DUP|||
PAD_RESTORE_LOCAL|||
PAD_SAVE_LOCAL|||
PAD_SAVE_SETNULLPAD|||
PAD_SETSV|||
PAD_SET_CUR_NOSAVE|||
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
PerlIO_get_cnt||5.007003|
PerlIO_get_ptr||5.007003|
PerlIO_read||5.007003|
PerlIO_seek||5.007003|
PerlIO_set_cnt||5.007003|
PerlIO_set_ptrcnt||5.007003|
PerlIO_setlinebuf||5.007003|
PerlIO_stderr||5.007003|
PerlIO_stdin||5.007003|
PerlIO_stdout||5.007003|
PerlIO_tell||5.007003|
PerlIO_unread||5.007003|
PerlIO_write||5.007003|
Perl_signbit||5.009005|n
PoisonFree|5.009004||p
PoisonNew|5.009004||p
PoisonWith|5.009004||p
SVt_PVAV|||
SVt_PVCV|||
SVt_PVHV|||
SVt_PVMG|||
SVt_PV|||
Safefree|||
Slab_Alloc|||
Slab_Free|||
Slab_to_rw|||
StructCopy|||
SvCUR_set|||
SvCUR|||
SvEND|||
SvGAMAGIC||5.006001|
SvGETMAGIC|5.004050||p
SvGROW|||
SvIOK_UV||5.006000|
SvIOK_notUV||5.006000|
SvIOK_off|||
SvIOK_only_UV||5.006000|
SvIOK_only|||
SvIOK_on|||
SvIOKp|||
SvIOK|||
SvIVX|||
SvIV_nomg|5.009001||p
SvIV_set|||
SvIVx|||
SvIV|||
SvIsCOW_shared_hash||5.008003|
SvIsCOW||5.008003|
SvLEN_set|||
SvLEN|||
SvLOCK||5.007003|
SvMAGIC_set|5.009003||p
SvNIOK_off|||
SvNIOKp|||
SvNIOK|||
SvNOK_off|||
SvNOK_only|||
SvNOK_on|||
SvNOKp|||
SvNOK|||
SvNVX|||
SvNV_set|||
SvNVx|||
SvNV|||
SvOK|||
SvOOK_offset||5.011000|
SvOOK|||
SvPOK_off|||
SvPOK_only_UTF8||5.006000|
SvPOK_only|||
SvPOK_on|||
SvPOKp|||
SvPOK|||
SvPVX_const|5.009003||p
SvPVX_mutable|5.009003||p
SvPVX|||
SvPV_force_nomg_nolen|5.009003||p
SvPV_force_nomg|5.007002||p
SvPV_force|||p
SvPV_mutable|5.009003||p
SvPV_nolen_const|5.009003||p
SvPV_nolen|5.006000||p
SvPV_nomg_const_nolen|5.009003||p
SvPV_nomg_const|5.009003||p
SvPV_nomg|5.007002||p
SvPV_renew|5.009003||p
SvPV_set|||
SvPVbyte_force||5.009002|
SvPVbyte_nolen||5.006000|
SvPVbytex_force||5.006000|
SvPVbytex||5.006000|
SvPVbyte|5.006000||p
SvPVutf8_force||5.006000|
SvPVutf8_nolen||5.006000|
SvPVutf8x_force||5.006000|
SvPVutf8x||5.006000|
SvPVutf8||5.006000|
SvREFCNT_inc_simple_void_NN|5.009004||p
SvREFCNT_inc_simple_void|5.009004||p
SvREFCNT_inc_simple|5.009004||p
SvREFCNT_inc_void_NN|5.009004||p
SvREFCNT_inc_void|5.009004||p
SvREFCNT_inc|||p
SvREFCNT|||
SvROK_off|||
SvROK_on|||
SvROK|||
SvRV_set|5.009003||p
SvRV|||
SvRXOK||5.009005|
SvRX||5.009005|
SvSETMAGIC|||
SvSHARED_HASH|5.009003||p
SvSHARE||5.007003|
SvSTASH_set|5.009003||p
SvSTASH|||
SvSetMagicSV_nosteal||5.004000|
SvSetMagicSV||5.004000|
SvSetSV_nosteal||5.004000|
SvSetSV|||
SvTAINTED_off||5.004000|
SvTAINTED_on||5.004000|
SvTAINTED||5.004000|
SvTAINT|||
SvTRUE|||
SvTYPE|||
SvUNLOCK||5.007003|
SvUOK|5.007001|5.006000|p
SvUPGRADE|||
SvUTF8_off||5.006000|
SvUTF8_on||5.006000|
SvUTF8||5.006000|
SvUVXx|5.004000||p
SvUVX|5.004000||p
SvUV_nomg|5.009001||p
SvUV_set|5.009003||p
SvUVx|5.004000||p
SvUV|5.004000||p
SvVOK||5.008001|
SvVSTRING_mg|5.009004||p
THIS|||n
UNDERBAR|5.009002||p
UTF8_MAXBYTES|5.009002||p
UVSIZE|5.006000||p
UVTYPE|5.006000||p
UVXf|5.007001||p
do_sysseek|||
do_tell|||
do_trans_complex_utf8|||
do_trans_complex|||
do_trans_count_utf8|||
do_trans_count|||
do_trans_simple_utf8|||
do_trans_simple|||
do_trans|||
do_vecget|||
do_vecset|||
do_vop|||
docatch|||
doeval|||
dofile|||
dofindlabel|||
doform|||
doing_taint||5.008001|n
dooneliner|||
doopen_pm|||
doparseform|||
filter_del|||
filter_gets|||
filter_read|||
find_and_forget_pmops|||
find_array_subscript|||
find_beginning|||
find_byclass|||
find_hash_subscript|||
find_in_my_stash|||
find_runcv||5.008001|
find_rundefsvoffset||5.009002|
find_script|||
find_uninit_var|||
first_symbol|||n
fold_constants|||
forbid_setid|||
force_ident|||
force_list|||
force_next|||
force_version|||
force_word|||
forget_pmop|||
form_nocontext|||vn
form||5.004000|v
fp_dup|||
fprintf_nocontext|||vn
gv_fetchpvs|5.009004||p
gv_fetchpv|||
gv_fetchsv||5.009002|
gv_fullname3||5.004000|
gv_fullname4||5.006001|
gv_fullname|||
gv_get_super_pkg|||
gv_handler||5.007001|
gv_init_sv|||
gv_init|||
gv_name_set||5.009004|
gv_stashpvn|5.004000||p
gv_stashpvs|5.009003||p
gv_stashpv|||
gv_stashsv|||
he_dup|||
hek_dup|||
hfreeentries|||
hsplit|||
hv_assert||5.011000|
hv_auxinit|||n
hv_clear_placeholders||5.009001|
hv_clear|||
hv_common_key_len||5.010000|
hv_common||5.010000|
hv_copy_hints_hv|||
hv_delayfree_ent||5.004000|
hv_delete_common|||
hv_delete_ent||5.004000|
hv_delete|||
hv_eiter_p||5.009003|
hv_eiter_set||5.009003|
hv_exists_ent||5.004000|
hv_exists|||
hv_fetch_ent||5.004000|
hv_fetchs|5.009003||p
hv_fetch|||
hv_free_ent||5.004000|
hv_iterinit|||
hv_iterkeysv||5.004000|
hv_iterkey|||
hv_iternext_flags||5.008000|
hv_iternextsv|||
hv_iternext|||
hv_iterval|||
hv_kill_backrefs|||
hv_ksplit||5.004000|
hv_magic_check|||n
hv_magic|||
hv_name_set||5.009003|
hv_notallowed|||
hv_placeholders_get||5.009003|
hv_placeholders_p||5.009003|
hv_placeholders_set||5.009003|
hv_riter_p||5.009003|
hv_riter_set||5.009003|
hv_scalar||5.009001|
hv_store_ent||5.004000|
hv_store_flags||5.008000|
hv_stores|5.009004||p
hv_store|||
hv_undef|||
ibcmp_locale||5.004000|
ibcmp_utf8||5.007003|
ibcmp|||
incline|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_len|||
magic_methcall|||
magic_methpack|||
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
magic_regdatum_set|||
magic_scalarpack|||
magic_set_all_env|||
magic_setamagic|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
magic_setutf8|||
magic_setuvar|||
magic_setvec|||
magic_set|||
magic_sizepack|||
magic_wipepack|||
make_matcher|||
make_trie_failtable|||
make_trie|||
malloc_good_size|||n
malloced_size|||n
malloc||5.007002|n
markstack_grow|||
matcher_matches_sv|||
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
missingterm|||
mode_from_discipline|||
modkids|||
mod|||
more_bodies|||
more_sv|||
moreswitches|||
mro_get_from_name||5.011000|
mro_get_linear_isa_dfs|||
mro_get_linear_isa||5.009005|
mro_get_private_data||5.011000|
mro_isa_changed_in|||
mro_meta_dup|||
mro_meta_init|||
mro_method_changed_in||5.009005|
mro_register||5.011000|
mro_set_mro||5.011000|
mro_set_private_data||5.011000|
mul128|||
mulexp10|||n
my_atof2||5.007002|
my_atof||5.006000|
my_attrs|||
my_bcopy|||n
my_betoh16|||n
my_betoh32|||n
my_betoh64|||n
my_betohi|||n
my_htonl|||
my_kid|||
my_letoh16|||n
my_letoh32|||n
my_letoh64|||n
my_letohi|||n
my_letohl|||n
my_letohs|||n
my_lstat|||
my_memcmp||5.004000|n
my_memset|||n
my_ntohl|||
my_pclose||5.004000|
my_popen_list||5.007001|
my_popen||5.004000|
my_setenv|||
my_snprintf|5.009004||pvn
my_socketpair||5.007003|n
my_sprintf|5.009003||pvn
my_stat|||
my_strftime||5.007002|
my_strlcat|5.009004||pn
my_strlcpy|5.009004||pn
my_swabn|||n
my_swap|||
my_unexec|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_peg|||n
pad_push|||
pad_reset|||
pad_setsv|||
pad_sv||5.011000|
pad_swipe|||
pad_tidy|||
pad_undef|||
parse_body|||
parse_unicode_opts|||
parser_dup|||
parser_free|||
path_is_absolute|||n
peep|||
save_op|||
save_padsv_and_mortalize||5.011000|
save_pptr|||
save_pushi32ptr|||
save_pushptri32ptr|||
save_pushptrptr|||
save_pushptr||5.011000|
save_re_context||5.006000|
save_scalar_at|||
save_scalar|||
save_set_svflags||5.009000|
save_shared_pvref||5.007003|
save_sptr|||
save_svref|||
save_vptr||5.006000|
savepvn|||
savepvs||5.009003|
savepv|||
savesharedpvn||5.009005|
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
scan_version||5.009001|
scan_vstring||5.009005|
scan_word|||
scope|||
screaminstr||5.005000|
search_const|||
seed||5.008001|
sequence_num|||
sequence_tail|||
sequence|||
set_context||5.006000|n
set_numeric_local||5.006000|
set_numeric_radix||5.006000|
set_numeric_standard||5.006000|
setdefout|||
share_hek_flags|||
share_hek||5.004000|
si_dup|||
sighandler|||n
simplify_sort|||
skipspace0|||
skipspace1|||
skipspace2|||
skipspace|||
softref2xv|||
sv_pvn||5.005000|
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|
sv_setpviv||5.008001|
sv_setpvn_mg|5.004050||p
sv_setpvn|||
sv_setpvs|5.009004||p
sv_setpv|||
sv_setref_iv|||
sv_setref_nv|||
sv_setref_pvn|||
sv_setref_pv|||
sv_setref_uv||5.007001|
sv_setsv_cow|||
sv_setsv_flags||5.007002|
sv_setsv_mg|5.004050||p
sv_setsv_nomg|5.007002||p
sv_setsv|||
sv_setuv_mg|5.004050||p
sv_setuv|5.004000||p
sv_tainted||5.004000|
sv_taint||5.004000|
sv_true||5.005000|
sv_unglob|||
sv_uni_display||5.007003|
sv_unmagic|||
sv_unref_flags||5.007001|
sv_unref|||
sv_untaint||5.004000|
sv_upgrade|||
sv_utf8_downgrade||5.006000|
sv_utf8_encode||5.006000|
sv_utf8_upgrade_flags_grow||5.011000|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade_nomg||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.005000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
sv_xmlpeek|||
svtype|||
swallow_bom|||
swap_match_buff|||
swash_fetch||5.007002|
swash_get|||
swash_init||5.006000|
sys_init3||5.010000|n
sys_init||5.010000|n
sys_intern_clear|||
# define IVSIZE 4 /* A bold guess, but the best we can make. */
# endif
#endif
#ifndef UVTYPE
# define UVTYPE unsigned IVTYPE
#endif
#ifndef UVSIZE
# define UVSIZE IVSIZE
#endif
#ifndef sv_setuv
# define sv_setuv(sv, uv) \
STMT_START { \
UV TeMpUv = uv; \
if (TeMpUv <= IV_MAX) \
sv_setiv(sv, TeMpUv); \
else \
sv_setnv(sv, (double)TeMpUv); \
} STMT_END
#endif
#ifndef newSVuv
# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
#endif
#ifndef sv_2uv
# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
#endif
#ifndef SvUVX
# define SvUOK(sv) SvIOK_UV(sv)
#endif
#ifndef XST_mUV
# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
#endif
#ifndef XSRETURN_UV
# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
#endif
#ifndef PUSHu
# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
#endif
#ifndef XPUSHu
# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#endif
#ifdef HAS_MEMCMP
#ifndef memNE
# define memNE(s1,s2,l) (memcmp(s1,s2,l))
#endif
#ifndef memEQ
# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
#endif
# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
#endif
#else
#ifndef ZeroD
# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
#endif
#endif
#ifndef PoisonWith
# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
#endif
#ifndef PoisonNew
# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
#endif
#ifndef PoisonFree
# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
#endif
/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
# define DEFSV GvSV(PL_defgv)
#endif
#ifndef SAVE_DEFSV
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
#ifndef DEFSV_set
# define DEFSV_set(sv) (DEFSV = (sv))
#endif
/* Older perls (<=5.003) lack AvFILLp */
#ifndef AvFILLp
# define AvFILLp AvFILL
#endif
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
#endif
#ifndef mPUSHs
# define mPUSHs(s) PUSHs(sv_2mortal(s))
#endif
#ifndef PUSHmortal
# define PUSHmortal PUSHs(sv_newmortal())
#endif
#ifndef mPUSHp
# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
#endif
#ifndef mPUSHn
# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
#endif
#ifndef mPUSHi
# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
#endif
#ifndef mPUSHu
# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
#endif
#ifndef mXPUSHs
# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
#endif
#ifndef XPUSHmortal
# define XPUSHmortal XPUSHs(sv_newmortal())
#endif
#ifndef mXPUSHp
# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
#endif
#ifndef mXPUSHn
# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
#endif
#ifndef mXPUSHi
# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
#endif
#ifndef mXPUSHu
# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
#endif
/* Replace: 1 */
#ifndef call_sv
# define call_sv perl_call_sv
#endif
#ifndef call_pv
# define call_pv perl_call_pv
#endif
my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
#define MY_CXT_INIT \
dMY_CXT_SV; \
/* newSV() allocates one more than needed */ \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
/* Judicious use of these macros can reduce the number of times dMY_CXT
* is used. Use is similar to pTHX, aTHX etc. */
#define pMY_CXT my_cxt_t *my_cxtp
#define pMY_CXT_ pMY_CXT,
#define _pMY_CXT ,pMY_CXT
#define _aMY_CXT ,aMY_CXT
#endif /* START_MY_CXT */
#ifndef MY_CXT_CLONE
/* Clones the per-interpreter data. */
#define MY_CXT_CLONE \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
#endif
#else /* single interpreter */
#ifndef START_MY_CXT
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define MY_CXT_INIT NOOP
#endif
#ifndef SvPV_nomg_const
# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
#endif
#ifndef SvPV_nomg_const_nolen
# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
#endif
#ifndef SvPV_renew
# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
SvPV_set((sv), (char *) saferealloc( \
(Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
} STMT_END
#endif
#ifndef SvMAGIC_set
# define SvMAGIC_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
(((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
#endif
#if (PERL_BCDVERSION < 0x5009003)
#ifndef SvPVX_const
# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
#endif
#ifndef SvPVX_mutable
# define SvPVX_mutable(sv) (0 + SvPVX(sv))
#endif
#ifndef SvRV_set
# define SvRV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
(((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
#endif
#else
#ifndef SvPVX_const
# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
#endif
#ifndef SvPVX_mutable
# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
#endif
#ifndef SvRV_set
# define SvRV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
((sv)->sv_u.svu_rv = (val)); } STMT_END
#endif
#endif
#ifndef SvSTASH_set
# define SvSTASH_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
(((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
#endif
#if (PERL_BCDVERSION < 0x5004000)
#ifndef SvUV_set
# define SvUV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
(((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
#endif
#else
#ifndef SvUV_set
# define SvUV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
(((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
#endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
#if defined(NEED_vnewSVpvf)
static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
static
#endif
#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
SV *
DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
{
register SV *sv = newSV(0);
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
return sv;
}
#endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg)
static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
#endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
# define sv_vcatpvf_mg(sv, pat, args) \
STMT_START { \
sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
SvSETMAGIC(sv); \
} STMT_END
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg)
static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext)
static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
static
#else
extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
#endif
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
#ifndef sv_setpvf_mg
# ifdef PERL_IMPLICIT_CONTEXT
# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
# else
# define sv_setpvf_mg Perl_sv_setpvf_mg
# endif
#endif
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
# define sv_vsetpvf_mg(sv, pat, args) \
STMT_START { \
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
SvSETMAGIC(sv); \
} STMT_END
#endif
#ifndef newSVpvn_share
#if defined(NEED_newSVpvn_share)
static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
static
#else
#endif
#ifndef newSVpvs_flags
# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
#endif
#ifndef sv_catpvs
# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
#endif
#ifndef sv_setpvs
# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
#endif
#ifndef hv_fetchs
# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
#endif
#ifndef hv_stores
# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
#endif
#ifndef gv_fetchpvn_flags
/* That's the best we can do... */
#ifndef sv_catpvn_nomg
# define sv_catpvn_nomg sv_catpvn
#endif
#ifndef sv_catsv_nomg
# define sv_catsv_nomg sv_catsv
#endif
#ifndef sv_setsv_nomg
# define sv_setsv_nomg sv_setsv
#endif
#ifndef sv_pvn_nomg
# define sv_pvn_nomg sv_pvn
#endif
#ifndef SvIV_nomg
# define SvIV_nomg SvIV
#endif
#ifndef sv_catsv_mg
# define sv_catsv_mg(dsv, ssv) \
STMT_START { \
SV *TeMpSv = dsv; \
sv_catsv(TeMpSv,ssv); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setiv_mg
# define sv_setiv_mg(sv, i) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setiv(TeMpSv,i); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setnv_mg
# define sv_setnv_mg(sv, num) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setnv(TeMpSv,num); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setpv_mg
# define sv_setpv_mg(sv, ptr) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setpv(TeMpSv,ptr); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setpvn_mg
# define sv_setpvn_mg(sv, ptr, len) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setpvn(TeMpSv,ptr,len); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setsv_mg
# define sv_setsv_mg(dsv, ssv) \
STMT_START { \
SV *TeMpSv = dsv; \
sv_setsv(TeMpSv,ssv); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_setuv_mg
# define sv_setuv_mg(sv, i) \
STMT_START { \
SV *TeMpSv = sv; \
sv_setuv(TeMpSv,i); \
SvSETMAGIC(TeMpSv); \
} STMT_END
#endif
#ifndef sv_usepvn_mg
# define sv_usepvn_mg(sv, ptr, len) \
STMT_START { \
SV *TeMpSv = sv; \
sv_usepvn(TeMpSv,ptr,len); \
SvSETMAGIC(TeMpSv); \
#ifdef USE_ITHREADS
#ifndef CopFILE
# define CopFILE(c) ((c)->cop_file)
#endif
#ifndef CopFILEGV
# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
#endif
#ifndef CopFILE_set
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
#endif
#ifndef CopFILESV
# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
#endif
#ifndef CopFILEAV
# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
#endif
#ifndef CopSTASHPV
# define CopSTASHPV(c) ((c)->cop_stashpv)
#endif
#ifndef CopSTASHPV_set
# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
#endif
#ifndef CopSTASH
# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
#endif
#ifndef CopSTASH_set
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
#endif
#ifndef CopSTASH_eq
# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
|| (CopSTASHPV(c) && HvNAME(hv) \
&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
#endif
#else
#ifndef CopFILEGV
# define CopFILEGV(c) ((c)->cop_filegv)
#endif
#ifndef CopFILEGV_set
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
#endif
#ifndef CopFILE_set
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
#endif
#ifndef CopFILESV
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
#endif
#ifndef CopFILEAV
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
#endif
#ifndef CopFILE
# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
#endif
#ifndef CopSTASH
# define CopSTASH(c) ((c)->cop_stash)
#endif
#ifndef CopSTASH_set
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
#endif
#ifndef CopSTASHPV
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
#endif
#ifndef CopSTASHPV_set
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
#endif
#ifndef CopSTASH_eq
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
#endif
#endif /* USE_ITHREADS */
#ifndef IN_PERL_COMPILETIME
# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#endif
value = value * 10 + digit;
if (++s < send)
digit = *s - '0';
else
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
#ifdef NO_XSLOCKS
# ifdef dJMPENV
# define dXCPT dJMPENV; int rEtV = 0
# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
# define XCPT_TRY_END JMPENV_POP;
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW JMPENV_JUMP(rEtV)
# else
# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
# endif
#endif
#if !defined(my_strlcat)
#if defined(NEED_my_strlcat)
static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
static
STRLEN chsize = 0;
STRLEN readsize = 1;
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
#endif
const char *pv = str;
const char * const end = pv + count;
octbuf[0] = esc;
if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
sv_setpvs(dsv, "");
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
isuni = 1;
#endif
for (; pv < end && (!max || wrote < max) ; pv += readsize) {
const UV u =
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
t/01-simple.t view on Meta::CPAN
is($a->height, 15, 'height');
is($a->start_x, 0, 'start_x of new map eq 0');
is($a->start_y, 0, 'start_y of new map eq 0');
is($a->last_x, 11, 'last_x of new map eq 0');
is($a->last_y, 14, 'last_y of new map eq 0');
my $s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy(40, 50 );
is($a->start_x, 40, 'start_x of map eq 40');
is($a->start_y, 50, 'start_y of map eq 50');
is($a->last_x, 40+11, 'last_x of map eq 51');
is($a->last_y, 50+14, 'last_y of map eq 64');
$s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy( -40, -50 );
is($a->start_x, -40, 'start_x of map eq -40');
is($a->start_y, -50, 'start_y of map eq -50');
is($a->last_x, -40+11, 'last_x of map eq -29');
is($a->last_y, -50+14, 'last_y of map eq -36');
$a->start_x(0);
is($a->start_x, 0, "set start x");
$a->start_y(0);
is($a->start_y, 0, "set start y");
# 10 + 8
my $s_1='';
$a->foreach_xy_set( sub { 1;} );
$a->foreach_xy( sub {$s_1.=$_} );
is($s_1, ('1' x (12*15)), "all 111");
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
t/02-passability.t view on Meta::CPAN
my $accum;
$accum = '';
for my $x(-2..14){
for my $y (-2..17){
$accum.= $m->get_passability($x,$y);
}
}
is($accum, ( '0' x (12*15)), "all 0");
$m->foreach_xy_set( sub { $a + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($a + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->foreach_xy_set( sub { $b + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($b + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->set_start_xy(-2, 2);
$m->foreach_xy_set( sub { $a + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($a + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->foreach_xy_set( sub { $b + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($b + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->set_start_xy(0,0);
my $count = 0;
$count = 0;
for my $x (0..11){
for my $y (0..14){
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
$m=$T->new({ width => 12, height => 15 });
$count = 0;
for my $y (0..14){
for my $x (0..11){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix no offset");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
{
my $m=$T->new({ width => 15, height => 12 });
for my $y(-2..14){
for my $x (-2..17){
ok(not $m->get_passability($x,$y));
}
}
$m->set_start_xy(0,0);
my $count = 0;
$count = 0;
for my $y (0..11){
for my $x (0..14){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
$m=$T->new({ width => 15, height => 12 });
$count = 0;
for my $x (0..14){
for my $y (0..11){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix no offset");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
}
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
t/03-path-valid.t view on Meta::CPAN
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
my $m = $T->new({ width => 5, height => 5 });
for my $d ("0".."9"){
is_deeply([$m->is_path_valid(0,0,$d)], ['']);
#print Dumper([$m->is_path_valid(0,0,$d)], ['']);
};
$m->set_start_xy(2,5);
for my $x (2..6){
for my $y(5..9){
$m->set_passability($x,$y, 1);
}
}
is_deeply( [$m->is_path_valid(2,5, $_)], [''], "failed from 2,5 path=$_") for split "", 74189;
is_deeply( [scalar $m->is_path_valid(2,5, $_)], [1], "success from 2,5 path=$_") for split "", 23605;
is_deeply( [$m->is_path_valid(2,9, $_)], [''], "failed from 2,9 path=$_") for split "", 12347;
is_deeply( [scalar $m->is_path_valid(2,9, $_)], [1], "success from 2,9 path=$_") for split "", 89605;
t/04-astar.t view on Meta::CPAN
}
{
my $m = $T->new( { width => 5, height => 5 } );
for my $d ( "0" .. "9" ) {
# is_deeply([$m->validate_path(0,0,$d)], ['']);
# print Dumper([$m->validate_path(0,0,$d)], ['']);
}
$m->set_start_xy( 2, 5 );
for my $x ( 2 .. 6 ) {
for my $y ( 5 .. 9 ) {
$m->set_passability( $x, $y, 1 );
}
}
is_deeply( [ $m->astar( 2, 5, 2, 5 ) ], [ '', 1 ], "empty path" );
is_deeply( [ $m->astar( 2, 5, 2, 6 ) ], [ '2', 1 ], " path= 8" );
is_deeply( [ $m->astar( 2, 5, 3, 5 ) ], [ '6', 1 ], " path= 6" );
is_deeply( [ $m->astar( 2, 5, 3, 6 ) ], [ '3', 1 ], " path= 9" );
for ( split "", 14789 ) {
my ( $x, $y ) = $m->path_goto( 2, 5, $_ );
is_deeply( [ $m->astar( 2, 5, $x, $y ) ], [""], "no path" );
t/05-foreach.t view on Meta::CPAN
my $ok = 1;
$m->foreach_xy( sub {$ok &&= defined $a && defined $b && defined $_ && $_ == 0; } );
is( $ok, 1, "foreach on empty");
is( $a, "TODO_a", '$a remain value' );
is( $b, "TODO_b", '$b remain value' );
is( $_, "TODO__", '$_ remain value' );
$ok = 1;
$m->foreach_xy_set( sub { $ok &&= defined $a && defined $b && defined $_ && $_ == 0 ; $a %2 } );
is( $ok, 1 , '$a, $b, $_ defined and right');
is( $a, "TODO_a", '$a remain value' );
is( $b, "TODO_b", '$b remain value' );
is( $_, "TODO__", '$_ remain value' );
$ok = 1;
$m->foreach_xy( sub {$ok &&= defined $a && defined $b && defined $_ && $_ == $a %2 ; } );
is( $ok, 1, "foreach on even \$a");
is( $m->get_passability( 0,0 ), 0, "(0,0)");
t/06-setstart.t view on Meta::CPAN
BEGIN {
$T = "AI::Pathfinding::AStar::Rectangle";
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
{
my $m = $T->new( { width => 5, height => 5 } );
$m->set_start_xy(-1, 0);
is( $m->begin_x, -1, "begin_x (1)");
is( $m->begin_y, 0, "begin_y (1)");
is( $m->start_x, -1, "start_x (1)");
is( $m->start_y, 0, "start_y (1)");
is( $m->end_x, 3, "end_x (2)");
is( $m->end_y, 4, "end_y (2)");
is( $m->last_x, 3, "last_x (2)");
is( $m->last_y, 4, "last_y (2)");
$m->set_start_xy( 0, -1);
is( $m->begin_x, 0, "begin_x (3)");
is( $m->begin_y, -1, "begin_y (3)");
is( $m->start_x, 0, "start_x (3)");
is( $m->start_y, -1, "start_y (3)");
is( $m->end_x, 4, "end_x (4)");
is( $m->end_y, 3, "end_y (4)");
is( $m->last_x, 4, "last_x (4)");
is( $m->last_y, 3, "last_y (4)");
t/07-dastar.t view on Meta::CPAN
BEGIN {
$T = "AI::Pathfinding::AStar::Rectangle";
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
{
my $m = $T->new( { width => 5, height => 5 } );
$m->set_start_xy( 2, 5 );
for my $x ( 2 .. 6 ) {
for my $y ( 5 .. 9 ) {
$m->set_passability( $x, $y, 1 );
}
}
is_deeply( [ $m->dastar( 2, 5, 2, 5 ) ], [ '', 1 ], "empty path" );
is_deeply( [ $m->dastar( 2, 5, 2, 6 ) ], [ '', 1 ], " path= 8" );
is_deeply( [ $m->dastar( 2, 5, 3, 5 ) ], [ '', 1 ], " path= 6" );
is_deeply( [ $m->dastar( 2, 5, 3, 6 ) ], [ '3', 1 ], " path= 9" );
for ( split "", 14789 ) {
my ( $x, $y ) = $m->path_goto( 2, 5, $_ );
is_deeply( [ $m->dastar( 2, 5, $x, $y ) ], [""], "no path" );
pmap MAP_OBJ
INPUT
MAP_OBJ
if ( !sv_isobject( $arg ) )
croak_xs_usage( cv, \"Need object\" );
$var = (pmap)SvPV_nolen(SvRV($arg));
OUTPUT
MAP_OBJ
sv_setiv($arg, (I32) $var);
( run in 1.575 second using v1.01-cache-2.11-cpan-49f99fa48dc )