=back
-You can use C<ok()> to report success or failure:
-
- ok($got, $expected, 'name');
- ok($got == 42); # Doesn't give good runtime diagnostics
-
- ok($got, eval "qr/foo/", 'name') # But don't execute this statement
- # on perls earlier than 5.005
-
-Unfortunately, the test name C<'name'> is output only on failure, so it can be
-awkward finding which of many tests executed at the same point in a loop is the
-one failing. Even though C<'name'> is optional, you will end up regretting not
-specifying it.
+As of version 3.56 of Devel::PPPort, the old Test style tests have been
+replaced with the more modern Test::More style, with some limitations. This
+means, for example, that C<is> is finally available, as well as
+C<done_testing>. You can pass the number of tests to C<skip>, instead of
+having to have your own C<for> loop.
+
+There is no C<like> nor C<unlike> (as those require C<qr> which didn't exist in
+the earliest perls that Devel::PPPort runs on).
+
+C<skip> doesn't do a S<C<last SKIP>>. (Perhaps it could, but that would mean
+converting all the skips in the existing tests.)
+
+The existing tests have been changed only as much as necessary so as to get
+things to work. But feel free to use the full functionality for any new tests
+you write.
+
+Here's a list of the supported functions:
+
+ cmp_ok
+ curr_test
+ diag
+ display
+ done_testing
+ eq_array
+ eq_hash
+ fail
+ is
+ isnt
+ next_test
+ note
+ ok
+ pass
+ plan
+ skip
+ skip_all
+ within
+
+These are copied from F<t/test.pl> in the perl distribution. Not all of them
+have been tested back as far as Devel::PPPort supports. Bug reports welcome.
It's fine to backport an element only as far as convenient and necessary. But
remember that your test file will end up being called on all perl versions
version. The recommended way to do this is like:
if (ivers($]) < ivers(5.6.2)) {
- skip "reason", 0;
+ skip "reason", $count;
}
elsif (if (ivers($]) > ivers(5.5) {
- skip "other reason", 0;
+ skip "other reason", $count;
}
-C<skip> doesn't work quite like the modern C<skip()> in, say, C<Test::More>.
-But you can pretend it pretty much does, by using it like the above. (And you
-really don't want to know the now-discarded API elements in it.) The C<"0">
-parameter is just to make it look like you know what you're doing.
-
C<ivers()> is a function automatically made available to all F<.t> files. It
converts any reasonble expression of a version number into an integer, which
can reliably be compared using numeric comparison operators, with the output of
#define bat baz
/* Replace: 0 */
-These replace C<foo> with C<bar>; C<bat> with C<baz>.
+These replace C<bar> with C<foo>; C<baz> with C<bat>. NOT the other way
+around.
=back
use strict;
use vars qw($VERSION $data);
-$VERSION = '3.55';
+$VERSION = '3.56';
sub _init_data
{
}
if (! $opt{'yes'}) {
- ask_or_quit("Are you SURE you have:\n1) updated parts/embed.fnc to latest blead?\n2) run devel/mkapidoc.sh to update parts/apidoc.fnc?\n3) run devel/mkppport_fnc.pl to update parts/ppport.fnc?\n");
+ ask_or_quit("Are you SURE you have:\n1) updated parts/embed.fnc to latest blead?\n2) run devel/mkapidoc.pl to update parts/apidoc.fnc?\n3) run devel/mkppport_fnc.pl to update parts/ppport.fnc?\n");
}
my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
Amnhd||G_METHOD
Amnhd||G_METHOD_NAMED
AmnUd||G_NOARGS
+Amnhd||G_RETHROW
AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send
AmnUd||G_SCALAR
Amnhd||GV_ADD
Amd|STRLEN|SvCUR|SV* sv
Amd|void|SvCUR_set|SV* sv|STRLEN len
Amd|char*|SvEND|SV* sv
+Amnhd||SVf
+Amhd||SVfARG|SV *sv
Amnhd||SVf_UTF8
Amd|U32|SvGAMAGIC|SV* sv
Amd|void|SvGETMAGIC|SV* sv
isPUNCT # E
isPUNCT_LC # E
is_utf8_char # U
-is_utf8_mark # E
isXDIGIT # E
IVdf # E
IVSIZE # E
init_i18nl10n # F added by devel/scanprov
init_i18nl14n # F added by devel/scanprov
is_handle_constructor # F added by devel/scanprov
-is_uni_alnum # F added by devel/scanprov
-is_uni_alnum_lc # F added by devel/scanprov
-is_uni_alpha # F added by devel/scanprov
-is_uni_alpha_lc # F added by devel/scanprov
-is_uni_ascii # F added by devel/scanprov
-is_uni_ascii_lc # F added by devel/scanprov
-is_uni_cntrl # F added by devel/scanprov
-is_uni_cntrl_lc # F added by devel/scanprov
-is_uni_digit # F added by devel/scanprov
-is_uni_digit_lc # F added by devel/scanprov
-is_uni_graph # F added by devel/scanprov
-is_uni_graph_lc # F added by devel/scanprov
-is_uni_idfirst # F added by devel/scanprov
-is_uni_idfirst_lc # F added by devel/scanprov
-is_uni_lower # F added by devel/scanprov
-is_uni_lower_lc # F added by devel/scanprov
-is_uni_print # F added by devel/scanprov
-is_uni_print_lc # F added by devel/scanprov
-is_uni_punct # F added by devel/scanprov
-is_uni_punct_lc # F added by devel/scanprov
-is_uni_space # F added by devel/scanprov
-is_uni_space_lc # F added by devel/scanprov
-is_uni_upper # F added by devel/scanprov
-is_uni_upper_lc # F added by devel/scanprov
-is_uni_xdigit # F added by devel/scanprov
-is_uni_xdigit_lc # F added by devel/scanprov
load_module_nocontext # F added by devel/scanprov
magic_killbackrefs # F added by devel/scanprov
magic_regdata_cnt # F added by devel/scanprov
sv_catpvf_nocontext # F added by devel/scanprov
sv_del_backref # F added by devel/scanprov
sv_setpvf_nocontext # F added by devel/scanprov
-swash_fetch # F added by devel/scanprov
-swash_init # F added by devel/scanprov
sys_intern_dup # F added by devel/scanprov
to_uni_lower # F added by devel/scanprov
-to_uni_lower_lc # F added by devel/scanprov
to_uni_title # F added by devel/scanprov
-to_uni_title_lc # F added by devel/scanprov
to_uni_upper # F added by devel/scanprov
-to_uni_upper_lc # F added by devel/scanprov
utf16_to_utf8 # F added by devel/scanprov
utf16_to_utf8_reversed # F added by devel/scanprov
warner_nocontext # F added by devel/scanprov
SvGAMAGIC # U
utf8_to_bytes # U
do_trans_complex # F added by devel/scanprov
-do_trans_complex_utf8 # F added by devel/scanprov
do_trans_count # F added by devel/scanprov
-do_trans_count_utf8 # F added by devel/scanprov
do_trans_simple # F added by devel/scanprov
-do_trans_simple_utf8 # F added by devel/scanprov
find_in_my_stash # F added by devel/scanprov
magic_regdatum_set # F added by devel/scanprov
report_evil_fh # F added by devel/scanprov
av_arylen_p # U
ckwarn # U
ckwarn_d # U
-csighandler # E (Perl_csighandler)
dAXMARK # E
dMULTICALL # E
doref # U
invlist_set_len # F added by devel/scanprov
invlist_trim # F added by devel/scanprov
_new_invlist # F added by devel/scanprov
-Perl_feature_is_enabled # F added by devel/scanprov
regcurly # F added by devel/scanprov
5.015007
-swatch_get # F added by devel/scanprov
find_runcv_where # F added by devel/scanprov
grok_bslash_x # F added by devel/scanprov
invlist_highest # F added by devel/scanprov
-is_uni_blank # F added by devel/scanprov
magic_cleararylen_p # F added by devel/scanprov
opslab_force_free # F added by devel/scanprov
opslab_free # F added by devel/scanprov
SvREFCNT_dec_NN # U
forget_pmop # F added by devel/scanprov
isFOO_lc # F added by devel/scanprov
-is_uni_alnumc # F added by devel/scanprov
-is_uni_alnumc_lc # F added by devel/scanprov
-is_uni_blank_lc # F added by devel/scanprov
_is_uni_perl_idstart # F added by devel/scanprov
isFOO_utf8_lc # F added by devel/scanprov
_is_uni_FOO # F added by devel/scanprov
_is_uni_perl_idcont # F added by devel/scanprov
-_is_utf8_mark # F added by devel/scanprov
get_c_backtrace_dump # F added by devel/scanprov
_is_cur_LC_category_utf8 # F added by devel/scanprov
_is_in_locale_category # F added by devel/scanprov
-_is_utf8_idcont # F added by devel/scanprov
-_is_utf8_idstart # F added by devel/scanprov
-_is_utf8_xidcont # F added by devel/scanprov
-_is_utf8_xidstart # F added by devel/scanprov
my_strerror # F added by devel/scanprov
should_warn_nl # F added by devel/scanprov
-swash_scan_list_line # F added by devel/scanprov
put_charclass_bitmap_innards # F added by devel/scanprov
put_code_point # F added by devel/scanprov
quadmath_format_needed # F added by devel/scanprov
-quadmath_format_single # F added by devel/scanprov
PadnameREFCNT # U
PadnameREFCNT_dec # U
gv_fetchmeth_internal # F added by devel/scanprov
-_make_exactf_invlist # F added by devel/scanprov
opmethod_stash # F added by devel/scanprov
pad_add_weakref # F added by devel/scanprov
padname_dup # F added by devel/scanprov
toUPPER_utf8_safe # U
_force_out_malformed_utf8_message # F added by devel/scanprov
_is_grapheme # F added by devel/scanprov
-is_utf8_common_with_len # F added by devel/scanprov
-_is_utf8_FOO_with_len # F added by devel/scanprov
-_is_utf8_perl_idcont_with_len # F added by devel/scanprov
-_is_utf8_perl_idstart_with_len # F added by devel/scanprov
warn_on_first_deprecated_use # F added by devel/scanprov
5.031006
UTF8_CHK_SKIP # U
+do_trans_count_invmap # F added by devel/scanprov
+do_trans_invmap # F added by devel/scanprov
+invmap_dump # F added by devel/scanprov
+_is_utf8_FOO # F added by devel/scanprov
+_is_utf8_perl_idcont # F added by devel/scanprov
+_is_utf8_perl_idstart # F added by devel/scanprov
+make_exactf_invlist # F added by devel/scanprov
+sv_derived_from_svpvn # F added by devel/scanprov
5.031007
-my_lstat # U (Perl_my_lstat)
-my_stat # U (Perl_my_stat)
-pack_cat # U (Perl_pack_cat)
-pad_compname_type # U (Perl_pad_compname_type)
+csighandler # E (Perl_csighandler)
+csighandler1 # U
+csighandler3 # E
+perly_sighandler # E
+find_first_differing_byte_pos # F added by devel/scanprov
+invlist_lowest # F added by devel/scanprov
+quadmath_format_valid # F added by devel/scanprov
+sighandler1 # F added by devel/scanprov
+sighandler3 # F added by devel/scanprov
p |void |gv_setref |NN SV *const dstr|NN SV *const sstr
Apd |HV* |gv_stashpv |NN const char* name|I32 flags
Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C)
+EpG |HV* |gv_stashsvpvn_cached |NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags
+#endif
#if defined(PERL_IN_GV_C)
i |HV* |gv_stashpvn_internal |NN const char* name|U32 namelen|I32 flags
-iG |HV* |gv_stashsvpvn_cached |NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags
i |GV* |gv_fetchmeth_internal |NULLOK HV* stash|NULLOK SV* meth|NULLOK const char* name \
|STRLEN len|I32 level|U32 flags
#endif
: Used in cop.h
XopR |I32 |was_lvalue_sub
CpRTP |STRLEN |is_utf8_char_helper|NN const U8 * const s|NN const U8 * e|const U32 flags
-CbDpR |U32 |to_uni_upper_lc|U32 c
-CbDpR |U32 |to_uni_title_lc|U32 c
-CbDpR |U32 |to_uni_lower_lc|U32 c
-CbDpR |bool |is_uni_alnum |UV c
-CbDpR |bool |is_uni_alnumc |UV c
-CbDpR |bool |is_uni_idfirst |UV c
-CbDpR |bool |is_uni_alpha |UV c
-CbDpPR |bool |is_uni_ascii |UV c
-CbDpPR |bool |is_uni_blank |UV c
-CbDpPR |bool |is_uni_space |UV c
-CbDpPR |bool |is_uni_cntrl |UV c
-CbDpR |bool |is_uni_graph |UV c
-CbDpR |bool |is_uni_digit |UV c
-CbDpR |bool |is_uni_upper |UV c
-CbDpR |bool |is_uni_lower |UV c
-CbDpR |bool |is_uni_print |UV c
-CbDpR |bool |is_uni_punct |UV c
-CbDpPR |bool |is_uni_xdigit |UV c
Cp |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp
Cp |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp
p |void |init_uniprops
Cp |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp
Cm |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp
Cp |UV |_to_uni_fold_flags|UV c|NN U8 *p|NN STRLEN *lenp|U8 flags
-CbDpR |bool |is_uni_alnum_lc|UV c
-CbDpR |bool |is_uni_alnumc_lc|UV c
-CbDpR |bool |is_uni_idfirst_lc|UV c
CpR |bool |_is_uni_perl_idcont|UV c
CpR |bool |_is_uni_perl_idstart|UV c
-CbDpR |bool |is_uni_alpha_lc|UV c
-CbDpPR |bool |is_uni_ascii_lc|UV c
-CbDpPR |bool |is_uni_space_lc|UV c
-CbDpPR |bool |is_uni_blank_lc|UV c
-CbDpPR |bool |is_uni_cntrl_lc|UV c
-CbDpR |bool |is_uni_graph_lc|UV c
-CbDpR |bool |is_uni_digit_lc|UV c
-CbDpR |bool |is_uni_upper_lc|UV c
-CbDpR |bool |is_uni_lower_lc|UV c
-CbDpR |bool |is_uni_print_lc|UV c
-CbDpR |bool |is_uni_punct_lc|UV c
-CbDpPR |bool |is_uni_xdigit_lc|UV c
ATdmoR |bool |is_utf8_invariant_string|NN const U8* const s \
|STRLEN len
ATidRp |bool |is_utf8_invariant_string_loc|NN const U8* const s \
|NN const U8 * const s|NN const U8 * const e
ATidRp |bool |is_utf8_valid_partial_char_flags \
|NN const U8 * const s|NN const U8 * const e|const U32 flags
-CpR |bool |_is_uni_FOO|const U8 classnum|const UV c
-CpR |bool |_is_utf8_FOO_with_len|const U8 classnum|NN const U8 *p \
- |NN const U8 * const e
-CpR |bool |_is_utf8_idcont|NN const U8 *p
-CpR |bool |_is_utf8_idstart|NN const U8 *p
-CpR |bool |_is_utf8_xidcont|NN const U8 *p
-CpR |bool |_is_utf8_xidstart|NN const U8 *p
-CpR |bool |_is_utf8_perl_idcont_with_len|NN const U8 *p \
+CpR |bool |_is_uni_FOO|const U8 classnum|const UV c
+CpR |bool |_is_utf8_FOO|const U8 classnum|NN const U8 *p \
|NN const U8 * const e
-CpR |bool |_is_utf8_perl_idstart_with_len|NN const U8 *p \
- |NN const U8 * const e
-CpR |bool |_is_utf8_mark |NN const U8 *p
-AbDxpR |bool |is_utf8_mark |NN const U8 *p
+CpR |bool |_is_utf8_perl_idcont|NN const U8 *p|NN const U8 * const e
+CpR |bool |_is_utf8_perl_idstart|NN const U8 *p|NN const U8 * const e
+
#if defined(PERL_CORE) || defined(PERL_EXT)
EXdpR |bool |isSCRIPT_RUN |NN const U8 *s|NN const U8 *send \
|const bool utf8_target
#if defined(PERL_IN_OP_C)
S |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl
#endif
+p |void |invmap_dump |NN SV* invlist|NN UV * map
Ap |void |pop_scope
Ap |void |push_scope
#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C)
pe |void |set_caret_X
Apd |void |setdefout |NN GV* gv
Ap |HEK* |share_hek |NN const char* str|SSize_t len|U32 hash
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+#ifdef PERL_USE_3ARG_SIGHANDLER
: Used in perl.c
-Tp |Signal_t |sighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap
-ATp |Signal_t |csighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap
+Tp |Signal_t |sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |csighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
#else
Tp |Signal_t |sighandler |int sig
ATp |Signal_t |csighandler |int sig
#endif
+Tp |Signal_t |sighandler1 |int sig
+ATp |Signal_t |csighandler1 |int sig
+Tp |Signal_t |sighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |csighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe
Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n
Ap |I32 |start_subparse |I32 is_format|U32 flags
Xp |void |init_named_cv |NN CV *cv|NN OP *nameop
|NULLOK va_list *const args|NULLOK SV **const svargs \
|const Size_t sv_count|NULLOK bool *const maybe_tainted
ApR |NV |str_to_version |NN SV *sv
-EXpR |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none
-EXp |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8
-#ifdef PERL_IN_REGCOMP_C
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
EiR |SV* |add_cp_to_invlist |NULLOK SV* invlist|const UV cp
+Ei |void |invlist_extend |NN SV* const invlist|const UV len
+Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
+EiRT |UV |invlist_highest|NN SV* const invlist
+EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist
+EiT |void |invlist_iterinit|NN SV* invlist
+EiRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
+EiT |void |invlist_iterfinish|NN SV* invlist
+#endif
+#if defined(PERL_IN_REGCOMP_C)
EiRT |bool |invlist_is_iterating|NN SV* const invlist
+EiR |SV* |invlist_contents|NN SV* const invlist \
+ |const bool traditional_style
+EixRT |UV |invlist_lowest|NN SV* const invlist
#ifndef PERL_EXT_RE_BUILD
EiRT |UV* |_invlist_array_init |NN SV* const invlist|const bool will_have_0
EiRT |UV |invlist_max |NN SV* const invlist
-ES |void |_append_range_to_invlist |NN SV* const invlist|const UV start|const UV end
-ES |void |invlist_extend |NN SV* const invlist|const UV len
-ES |void |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src
EiRT |IV* |get_invlist_previous_index_addr|NN SV* invlist
-Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
EiT |void |invlist_set_previous_index|NN SV* const invlist|const IV index
EiRT |IV |invlist_previous_index|NN SV* const invlist
EiT |void |invlist_trim |NN SV* invlist
Ei |void |invlist_clear |NN SV* invlist
-S |void |initialize_invlist_guts|NN SV* invlist|const Size_t initial_size
#endif
-EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist
-EiT |void |invlist_iterinit|NN SV* invlist
-ESRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
-EiT |void |invlist_iterfinish|NN SV* invlist
-EiRT |UV |invlist_highest|NN SV* const invlist
-ERS |SV* |_make_exactf_invlist |NN RExC_state_t *pRExC_state \
- |NN regnode *node
-ESR |SV* |invlist_contents|NN SV* const invlist \
- |const bool traditional_style
ESRT |bool |new_regcurly |NN const char *s|NN const char *e
+ERS |SV* |make_exactf_invlist |NN RExC_state_t *pRExC_state \
+ |NN regnode *node
+#ifndef PERL_EXT_RE_BUILD
+ES |void |_append_range_to_invlist |NN SV* const invlist|const UV start|const UV end
+ES |void |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src
+S |void |initialize_invlist_guts|NN SV* invlist|const Size_t initial_size
+#endif
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
m |void |_invlist_intersection |NN SV* const a|NN SV* const b|NN SV** i
EXp |void |_invlist_intersection_maybe_complement_2nd \
|NULLOK SV* const a|NN SV* const b \
#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_SV_C)
EpX |SV* |invlist_clone |NN SV* const invlist|NULLOK SV* newlist
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) \
+ || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) \
+ || defined(PERL_IN_PP_C) || defined(PERL_IN_OP_C) \
+ || defined(PERL_IN_DOOP_C)
EiRT |UV* |invlist_array |NN SV* const invlist
EiRT |bool |is_invlist |NULLOK SV* const invlist
EiRT |bool* |get_invlist_offset_addr|NN SV* invlist
|NULLOK SV **lonly_utf8_locale \
|NULLOK SV **output_invlist
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) || defined(PERL_IN_OP_C)
EXp |void |_invlist_dump |NN PerlIO *file|I32 level \
|NN const char* const indent \
|NN SV* const invlist
#endif
Ap |void |taint_env
Ap |void |taint_proper |NULLOK const char* f|NN const char *const s
-Ep |char * |_byte_dump_string \
+EXp |char * |_byte_dump_string \
|NN const U8 * const start \
|const STRLEN len \
|const bool format
p |void |init_constants
#if defined(PERL_IN_DOOP_C)
-SR |Size_t |do_trans_simple |NN SV * const sv
-SR |Size_t |do_trans_count |NN SV * const sv
-SR |Size_t |do_trans_complex |NN SV * const sv
-SR |Size_t |do_trans_simple_utf8 |NN SV * const sv
-SR |Size_t |do_trans_count_utf8 |NN SV * const sv
-SR |Size_t |do_trans_complex_utf8 |NN SV * const sv
+SR |Size_t |do_trans_simple |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_count |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_complex |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_invmap |NN SV * const sv|NN AV * const map
+SR |Size_t |do_trans_count_invmap |NN SV * const sv|NN AV * const map
#endif
#if defined(PERL_IN_GV_C)
ES |void |output_posix_warnings \
|NN RExC_state_t *pRExC_state \
|NN AV* posix_warnings
+EiT |Size_t |find_first_differing_byte_pos|NN const U8 * s1|NN const U8 * s2| const Size_t max
ES |AV* |add_multi_match|NULLOK AV* multi_char_matches \
|NN SV* multi_string \
|const STRLEN cp_count
|NULLOK SV* nonbitmap_invlist \
|NULLOK SV* only_utf8_locale_invlist\
|NULLOK const regnode * const node \
+ |const U8 flags \
|const bool force_as_is_display
ES |SV* |put_charclass_bitmap_innards_common \
|NN SV* invlist \
|bool curstash
#if defined(PERL_IN_UNIVERSAL_C)
-S |bool |isa_lookup |NN HV *stash|NN const char * const name \
+SG |bool |isa_lookup |NULLOK HV *stash|NULLOK SV *namesv|NULLOK const char * name \
|STRLEN len|U32 flags
+SG |bool |sv_derived_from_svpvn |NULLOK SV *sv \
+ |NULLOK SV *namesv \
+ |NULLOK const char * name \
+ |const STRLEN len \
+ |U32 flags
#endif
#if defined(PERL_IN_LOCALE_C)
|NN U8* const ustrp \
|NN STRLEN *lenp
iR |bool |is_utf8_common |NN const U8 *const p \
+ |NN const U8 *const e \
|NULLOK SV* const invlist
-iR |bool |is_utf8_common_with_len|NN const U8 *const p \
- |NN const U8 *const e \
- |NULLOK SV* const invlist
-SR |SV* |swatch_get |NN SV* swash|UV start|UV span
-SR |U8* |swash_scan_list_line|NN U8* l|NN U8* const lend|NN UV* min \
- |NN UV* max|NN UV* val|const bool wants_value \
- |NN const U8* const typestr
#endif
EXiTp |void |append_utf8_from_native_byte|const U8 byte|NN U8** dest
ApT |int |my_socketpair |int family|int type|int protocol|int fd[2]
ApT |int |my_dirfd |NULLOK DIR* dir
#ifdef PERL_ANY_COW
-: Used in pp_hot.c and regexec.c
+: Used in regexec.c
pxXE |SV* |sv_setsv_cow |NULLOK SV* dstr|NN SV* sstr
#endif
AMpTdf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|...
AMpTd |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap
#ifdef USE_QUADMATH
-ApTd |const char* |quadmath_format_single|NN const char* format
-ApTd |bool|quadmath_format_needed|NN const char* format
+pTd |bool |quadmath_format_valid|NN const char* format
+pTd |bool|quadmath_format_needed|NN const char* format
#endif
: Used in mg.c, sv.c
: Used in perl.c and toke.c
op |void |populate_isa |NN const char *name|STRLEN len|...
-: Used in keywords.c and toke.c
-Xop |bool |feature_is_enabled|NN const char *const name \
- |STRLEN namelen
-
: Some static inline functions need predeclaration because they are used
: inside other static inline functions.
#if defined(PERL_CORE) || defined (PERL_EXT)
=tests plan => 4
-ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
+is(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
ok(!defined Devel::PPPort::HvNAME_get({}));
-ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
-ok(Devel::PPPort::HvNAMELEN_get({}), 0);
+is(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
+is(Devel::PPPort::HvNAMELEN_get({}), 0);
my $mhx = "mhx";
-ok(&Devel::PPPort::SvPVbyte($mhx), 3);
+is(&Devel::PPPort::SvPVbyte($mhx), 3);
my $i = 42;
-ok(&Devel::PPPort::SvPV_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
+is(&Devel::PPPort::SvPV_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_force($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
my $str = "";
&Devel::PPPort::SvPV_force($str);
my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
-ok($str, "x"x80);
-ok($s2, "x"x80);
+is($str, "x"x80);
+is($s2, "x"x80);
ok($before < 81);
-ok($after, 81);
+is($after, 81);
$str = "x"x400;
&Devel::PPPort::SvPV_force($str);
($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
-ok($str, "x"x40);
-ok($s2, "x"x40);
+is($str, "x"x40);
+is($s2, "x"x40);
ok($before > 41);
-ok($after, 41);
+is($after, 41);
=tests plan => 15
my $foo = 5;
-ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
-ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
-ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
+is(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
+is(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
+is(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
my $bar = [];
bless $bar, 'foo';
-ok($bar->x(), 'foobar');
+is($bar->x(), 'foobar');
Devel::PPPort::TestSvSTASH_set($bar, 'bar');
-ok($bar->x(), 'hacker');
+is($bar->x(), 'hacker');
if ( "$]" < '5.007003' ) {
- for (1..10) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 10;
} else {
ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL());
tie my $scalar, 'TieScalarCounter', 'string';
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $copy = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $copy2 = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok $copy2, 'string';
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is $copy2, 'string';
}
package TieScalarCounter;
=tests plan => 86
-sub eq_array
-{
- my($a, $b) = @_;
- join(':', @$a) eq join(':', @$b);
-}
-
sub f
{
shift;
ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
};
-ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
-ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+is(&Devel::PPPort::eval_pv('f()', 0), 'y');
+is(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
-ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
+is(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
Devel::PPPort::load_module(0, "less", undef);
-ok(defined $::{'less::'}, 1, "Have now loaded less");
+is(defined $::{'less::'}, 1, "Have now loaded less");
ok(eval { Devel::PPPort::eval_pv('die', 0); 1 });
ok(!eval { Devel::PPPort::eval_pv('die', 1); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
ok(eval { Devel::PPPort::eval_sv('die', 0); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
{
#endif /* 5.6.0 */
-=tests plan => 28
+=tests plan => 8
my $package;
{
$package = &Devel::PPPort::CopSTASHPV();
}
print "# $package\n";
-ok($package, "MyPackage");
+is($package, "MyPackage");
my $file = &Devel::PPPort::CopFILE();
print "# $file\n";
BEGIN {
if ("$]" < 5.006000) {
- # Skip
- for (1..28) {
- ok(1, 1);
- }
+ skip("Perl version too early", 8);
exit;
}
}
) {
my ($sub, $arg, @want) = @$_;
my @got = $sub->($arg);
- ok(@got, @want);
- for (0..$#want) {
- ok($got[$_], $want[$_]);
- }
+ ok(eq_array(\@got, \@want));
}
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(0) };
-ok($@, '');
+is($@, '');
ok(defined $rv);
-ok($rv, 42);
-ok($Devel::PPPort::exception_caught, 0);
+is($rv, 42);
+is($Devel::PPPort::exception_caught, 0);
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(1) };
-ok($@, "boo\n");
+is($@, "boo\n");
ok(not defined $rv);
-ok($Devel::PPPort::exception_caught, 1);
+is($Devel::PPPort::exception_caught, 1);
use Config;
if ("$]" < '5.004') {
- for (1..5) {
- skip 'skip: No newSVpvf support', 0;
- }
+ skip 'skip: No newSVpvf support', 5;
exit;
}
eval { Devel::PPPort::croak_NVgf($num) };
ok($@ =~ /^1.1234567890/);
-ok(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
-ok(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
+is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
+is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
my $ivsize = $Config::Config{ivsize};
my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0;
my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0;
if ($ivmax == 0) {
- for (1..2) {
- skip 'skip: unknown ivsize', 0;
- }
+ skip 'skip: unknown ivsize', 2;
} else {
- ok(Devel::PPPort::sprintf_ivmax(), $ivmax);
- ok(Devel::PPPort::sprintf_uvmax(), $uvmax);
+ is(Devel::PPPort::sprintf_ivmax(), $ivmax);
+ is(Devel::PPPort::sprintf_uvmax(), $uvmax);
}
=tests plan => 10
-ok(&Devel::PPPort::grok_number("42"), 42);
+is(&Devel::PPPort::grok_number("42"), 42);
ok(!defined(&Devel::PPPort::grok_number("A")));
-ok(&Devel::PPPort::grok_bin("10000001"), 129);
-ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::grok_oct("377"), 255);
+is(&Devel::PPPort::grok_bin("10000001"), 129);
+is(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::grok_oct("377"), 255);
-ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+is(&Devel::PPPort::Perl_grok_number("42"), 42);
ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
-ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
-ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+is(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+is(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::Perl_grok_oct("377"), 255);
=tests plan => 7
-ok(Devel::PPPort::GvSVn(), 1);
+is(Devel::PPPort::GvSVn(), 1);
-ok(Devel::PPPort::isGV_with_GP(), 2);
+is(Devel::PPPort::isGV_with_GP(), 2);
-ok(Devel::PPPort::get_cvn_flags(), 3);
+is(Devel::PPPort::get_cvn_flags(), 3);
-ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
+is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
ok($::{sanity_check});
# if { VERSION >= 5.21.3 }
# undef sync_locale
# define sync_locale() (Perl_sync_locale(aTHX), 1)
+# elif defined(sync_locale) /* These should be the 5.20 maints*/
+# undef sync_locale /* Just copy their defn and return 1 */
+# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), \
+ new_collate(setlocale(LC_COLLATE, NULL)), \
+ set_numeric_local(), \
+ new_numeric(setlocale(LC_NUMERIC, NULL)), \
+ 1)
# elif defined(new_ctype) && defined(LC_CTYPE)
# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), 1)
-# else
-# undef sync_locale
# endif
# endif
#endif
=tests plan => 10
-ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
-
-ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+
+is(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
# Find proper magic
ok(my $obj1 = Devel::PPPort->new_with_mg());
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Find with no magic
my $obj = bless {}, 'Fake::Class';
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Find with other magic (not the magic we are looking for)
ok($obj = Devel::PPPort->new_with_other_mg());
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Okay, attempt to remove magic that isn't there
Devel::PPPort::remove_other_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Remove magic that IS there
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
# Removing when no magic present
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
use Tie::Hash;
my %h;
$h{bar} = '';
&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
-ok($h{foo}, 'foobar');
+is($h{foo}, 'foobar');
&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
-ok($h{bar}, 'baz');
+is($h{bar}, 'baz');
&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
-ok($h{foo}, 'foobar42');
+is($h{foo}, 'foobar42');
&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
-ok($h{bar}, 42);
+is($h{bar}, 42);
&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);
&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
-ok($h{mhx}, 'mhx');
+is($h{mhx}, 'mhx');
&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
-ok($h{mhx}, 'Marcus');
+is($h{mhx}, 'Marcus');
&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
-ok($h{sv}, 'SV');
+is($h{sv}, 'SV');
&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
-ok($h{sv}, 4711);
+is($h{sv}, 4711);
&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
-ok($h{sv}, 'Perl');
+is($h{sv}, 'Perl');
# v1 is treated as a bareword in older perls...
my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] };
ok($foo eq 'bar');
if ( "$]" < '5.007003' ) {
- for (1..22) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 22;
} else {
tie my $scalar, 'TieScalarCounter', 10;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvIV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvUV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvNV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvIV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvUV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvNV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
ok Devel::PPPort::magic_SvTRUE_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $object = OverloadedObject->new('string', 5.5, 0);
- ok Devel::PPPort::magic_SvIV_nomg($object), 5;
- ok Devel::PPPort::magic_SvUV_nomg($object), 5;
- ok Devel::PPPort::magic_SvNV_nomg($object), 5.5;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
+ is Devel::PPPort::magic_SvIV_nomg($object), 5;
+ is Devel::PPPort::magic_SvUV_nomg($object), 5;
+ is Devel::PPPort::magic_SvNV_nomg($object), 5.5;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
ok !Devel::PPPort::magic_SvTRUE_nomg($object);
}
=tests plan => 1
-ok(Devel::PPPort::checkmem(), 6);
+is(Devel::PPPort::checkmem(), 6);
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") };
-ok $@, "\xE1\n";
-ok $die, "\xE1\n";
+is $@, "\xE1\n";
+is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(10) };
-ok $@ =~ /^10 at $0 line /;
-ok $die =~ /^10 at $0 line /;
+ok $@ =~ /^10 at \Q$0\E line /;
+ok $die =~ /^10 at \Q$0\E line /;
undef $die;
$@ = 'should not be visible (1)';
$@ = 'should not be visible (2)';
Devel::PPPort::croak_sv('');
};
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv($@)
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv($@)
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv_errsv()
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv_errsv()
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv_with_counter("message\n") };
-ok $@, "message\n";
-ok Devel::PPPort::get_counter(), 1;
+is $@, "message\n";
+is Devel::PPPort::get_counter(), 1;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv('') };
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1") };
-ok $@ =~ /^\xE1 at $0 line /;
-ok $die =~ /^\xE1 at $0 line /;
+ok $@ =~ /^\xE1 at \Q$0\E line /;
+ok $die =~ /^\xE1 at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
-ok $@ =~ /^\xC3\xA1 at $0 line /;
-ok $die =~ /^\xC3\xA1 at $0 line /;
+ok $@ =~ /^\xC3\xA1 at \Q$0\E line /;
+ok $die =~ /^\xC3\xA1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1\n");
-ok $warn, "\xE1\n";
+is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(10);
-ok $warn =~ /^10 at $0 line /;
+ok $warn =~ /^10 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv('');
-ok $warn =~ /^ at $0 line /;
+ok $warn =~ /^ at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1");
-ok $warn =~ /^\xE1 at $0 line /;
+ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
-ok $warn =~ /^\xC3\xA1 at $0 line /;
+ok $warn =~ /^\xC3\xA1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
+is Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
+is Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
-ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at $0 line /;
+ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv('', 0) =~ /^ at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at $0 line /;
+ok Devel::PPPort::mess_sv('', 0) =~ /^ at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at \Q$0\E line /;
if ("$]" >= '5.006') {
BEGIN { if ("$]" >= '5.006' && "$]" < '5.008') { require utf8; utf8->import(); } }
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@, "\x{100}\n";
+ is $@, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die, "\x{100}\n";
+ is $die, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@ =~ /^\x{100} at $0 line /;
+ ok $@ =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die =~ /^\x{100} at $0 line /;
+ ok $die =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
undef $warn;
Devel::PPPort::warn_sv("\x{100}\n");
- ok $warn, "\x{100}\n";
+ is $warn, "\x{100}\n";
undef $warn;
Devel::PPPort::warn_sv("\x{100}");
- ok (my $tmp = $warn) =~ /^\x{100} at $0 line /;
+ ok (my $tmp = $warn) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..2) {
- skip 'skip: broken utf8 support in warn hook', 0;
- }
+ skip 'skip: broken utf8 support in warn hook', 2;
}
- ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
+ is Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
+ is Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
- ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at $0 line /;
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at $0 line /;
+ ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at \Q$0\E line /;
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..12) {
- skip 'skip: no utf8 support', 0;
- }
+ skip 'skip: no utf8 support', 12;
}
if (ord('A') != 65) {
- for (1..24) {
- skip 'skip: no ASCII support', 0;
- }
+ skip 'skip: no ASCII support', 24;
} elsif ( "$]" >= '5.008'
&& "$]" != '5.013000' # Broken in these ranges
&& ! ("$]" >= '5.011005' && "$]" <= '5.012000'))
{
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
- ok $@, "\xE1\n";
- ok $die, "\xE1\n";
+ is $@, "\xE1\n";
+ is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
- ok $@ =~ /^\xE1 at $0 line /;
- ok $die =~ /^\xE1 at $0 line /;
+ ok $@ =~ /^\xE1 at \Q$0\E line /;
+ ok $die =~ /^\xE1 at \Q$0\E line /;
{
undef $die;
my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
- ok $@, $expect;
- ok $die, $expect;
+ is $@, $expect;
+ is $die, $expect;
}
{
undef $die;
- my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
ok $@ =~ $expect;
ok $die =~ $expect;
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
- ok $warn, "\xE1\n";
+ is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
- ok $warn =~ /^\xE1 at $0 line /;
+ ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1\n");
- ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';
+ is $warn, eval '"\N{U+C3}\N{U+A1}\n"';
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
- ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
if ("$]" < '5.004') {
- for (1..8) {
- skip 'skip: no support for mess_sv', 0;
- }
+ skip 'skip: no support for mess_sv', 8;
}
else {
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at $0 line /';
+ ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
- ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
}
} else {
- for (1..24) {
- skip 'skip: no support for \N{U+..} syntax', 0;
- }
+ skip 'skip: no support for \N{U+..} syntax', 24;
}
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
ok $@ == $obj;
ok $die == $obj;
} else {
- for (1..12) {
- skip 'skip: no support for exceptions', 0;
- }
+ skip 'skip: no support for exceptions', 12;
}
ok !defined eval { Devel::PPPort::croak_no_modify() };
-ok $@ =~ /^Modification of a read-only value attempted at $0 line /;
+ok $@ =~ /^Modification of a read-only value attempted at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_memory_wrap() };
-ok $@ =~ /^panic: memory wrap at $0 line /;
+ok $@ =~ /^panic: memory wrap at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_xs_usage("params") };
-ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at $0 line /;
+ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at \Q$0\E line /;
ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
-ok(&Devel::PPPort::DEFSV(), "Fred");
-ok(&Devel::PPPort::UNDERBAR(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::UNDERBAR(), "Fred");
if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) {
eval q{
no warnings "deprecated";
no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
my $_ = "Tony";
- ok(&Devel::PPPort::DEFSV(), "Fred");
- ok(&Devel::PPPort::UNDERBAR(), "Tony");
+ is(&Devel::PPPort::DEFSV(), "Fred");
+ is(&Devel::PPPort::UNDERBAR(), "Tony");
};
}
else {
my @r = &Devel::PPPort::DEFSV_modify();
ok(@r == 3);
-ok($r[0], 'Fred');
-ok($r[1], 'DEFSV');
-ok($r[2], 'Fred');
+is($r[0], 'Fred');
+is($r[1], 'DEFSV');
+is($r[2], 'Fred');
-ok(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
eval { 1 };
ok(!&Devel::PPPort::ERRSV());
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
-ok(Devel::PPPort::dXSTARG(42), 43);
-ok(Devel::PPPort::dAXMARK(4711), 4710);
+is(Devel::PPPort::dXSTARG(42), 43);
+is(Devel::PPPort::dAXMARK(4711), 4710);
-ok(Devel::PPPort::prepush(), 42);
+is(Devel::PPPort::prepush(), 42);
-ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
-ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
+is(join(':', Devel::PPPort::xsreturn(0)), 'test1');
+is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
-ok(Devel::PPPort::PERL_ABS(42), 42);
-ok(Devel::PPPort::PERL_ABS(-13), 13);
+is(Devel::PPPort::PERL_ABS(42), 42);
+is(Devel::PPPort::PERL_ABS(-13), 13);
-ok(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
-ok(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
+is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
+is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
-ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
+is(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
-ok(&Devel::PPPort::ptrtests(), 63);
+is(&Devel::PPPort::ptrtests(), 63);
-ok(&Devel::PPPort::OpSIBLING_tests(), 0);
+is(&Devel::PPPort::OpSIBLING_tests(), 0);
if (ivers($]) >= ivers(5.9)) {
eval q{
- ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
- ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
+ is(&Devel::PPPort::check_HeUTF8("hello"), "norm");
+ is(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
};
} else {
- ok(1, 1);
- ok(1, 1);
+ skip("Too early perl version", 2);
}
@r = &Devel::PPPort::check_c_array();
-ok($r[0], 4);
-ok($r[1], "13");
+is($r[0], 4);
+is($r[1], "13");
ok(!Devel::PPPort::SvRXOK(""));
ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
if (ivers($]) < ivers(5.5)) {
- skip 'no qr// objects in this perl', 0;
- skip 'no qr// objects in this perl', 0;
+ skip 'no qr// objects in this perl', 2;
} else {
my $qr = eval 'qr/./';
ok(Devel::PPPort::SvRXOK($qr));
? 0 # Fail on non-ASCII unless unicode
: ($types{"$native:$class"} || 0);
if (ivers($]) < ivers(5.6) && $suffix eq '_uvchr') {
- skip("No UTF-8 on this perl", 0);
+ skip("No UTF-8 on this perl", 1);
next;
}
my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
my $is = eval $eval_string || 0;
die "eval 'For $i: $eval_string' gave $@" if $@;
- ok($is, $should_be, "'$eval_string'");
+ is($is, $should_be, "'$eval_string'");
}
}
my $utf8;
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
else {
$utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
my $should_be = $types{"$native:$class"} || 0;
+ local $SIG{__WARN__} = sub {};
my $eval_string = "$fcn(\"$utf8\", 0)";
my $is = eval $eval_string || 0;
die "eval 'For $i, $eval_string' gave $@" if $@;
- ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
}
# And for the high code points, test that a too short malformation (the
# -1) causes it to fail
if ($i > 255) {
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
elsif (ivers($]) >= ivers(5.25.9)) {
- skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
+ skip("Prints an annoying error message that khw doesn't know how to easily suppress", 1);
}
else {
my $eval_string = "$fcn(\"$utf8\", -1)";
my $is = eval "no warnings; $eval_string" || 0;
die "eval '$eval_string' gave $@" if $@;
- ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
}
}
}
$skip = "Can't do uvchr on a multi-char string";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
if ($is_cp) {
my $ret = eval "Devel::PPPort::$fcn($original)";
my $fail = $@; # Have to save $@, as it gets destroyed
- ok ($fail, "", "$fcn($original) didn't fail");
+ is ($fail, "", "$fcn($original) didn't fail");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
$skip = "Don't try to test shortened single bytes";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
my $fcn = "to${name}_utf8_safe";
my $ret = eval "no warnings; $eval_string" || 0;
my $fail = $@; # Have to save $@, as it gets destroyed
if ($truncate == 0) {
- ok ($fail, "", "Didn't fail on full length input");
+ is ($fail, "", "Didn't fail on full length input");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
else {
- ok ($fail, eval 'qr/Malformed UTF-8 character/',
+ is ($fail, eval 'qr/Malformed UTF-8 character/',
"Gave appropriate error for short char: $original");
- for (1..3) {
- skip("Expected failure means remaining tests for"
- . " this aren't relevant", 0);
- }
+ skip("Expected failure means remaining tests for"
+ . " this aren't relevant", 3);
}
}
}
}
}
-ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
-ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
+is(&Devel::PPPort::av_top_index([1,2,3]), 2);
+is(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
=tests plan => 3
&Devel::PPPort::call_newCONSTSUB_1();
-ok(&Devel::PPPort::test_value_1(), 1);
+is(&Devel::PPPort::test_value_1(), 1);
&Devel::PPPort::call_newCONSTSUB_2();
-ok(&Devel::PPPort::test_value_2(), 2);
+is(&Devel::PPPort::test_value_2(), 2);
&Devel::PPPort::call_newCONSTSUB_3();
-ok(&Devel::PPPort::test_value_3(), 3);
+is(&Devel::PPPort::test_value_3(), 3);
=tests plan => 2
-ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
-ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+is(&Devel::PPPort::newRV_inc_REFCNT, 1);
+is(&Devel::PPPort::newRV_noinc_REFCNT, 1);
=tests plan => 1
-ok(Devel::PPPort::newSV_type(), 4);
+is(Devel::PPPort::newSV_type(), 4);
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_flags();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_utf8();
ok(@s == 1);
-ok($s[0], "test");
+is($s[0], "test");
if ("$]" >= 5.008001) {
require utf8;
ok(utf8::is_utf8($s[0]));
}
else {
- skip("skip: no is_utf8()", 0);
+ skip("skip: no is_utf8()", 1);
}
for (@pods) {
print "# checking $_\n";
if ($reason) {
- skip("skip: $reason", 0);
+ skip("skip: $reason", 1);
}
else {
pod_file_ok($_);
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 238) {
- skip("skip: SKIP_SLOW_TESTS", 0);
- }
+ skip("skip: SKIP_SLOW_TESTS", 238);
exit 0;
}
}
ok(&Devel::PPPort::WriteFile("ppport.h"));
# Check GetFileContents()
-ok(-e "ppport.h", 1);
+is(-e "ppport.h", 1);
my $data;
}
close(F);
-ok(Devel::PPPort::GetFileContents("ppport.h"), $data);
-ok(Devel::PPPort::GetFileContents(), $data);
+is(Devel::PPPort::GetFileContents("ppport.h"), $data);
+is(Devel::PPPort::GetFileContents(), $data);
sub comment
{
$err =~ s/^/# *** /mg;
print "# *** ERROR ***\n$err\n";
}
- ok($@, '');
+ is($@, '');
for (keys %{$t->{files}}) {
unlink $_ or die "unlink('$_'): $!\n";
$o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*test\.xs/mi);
ok($o =~ /Analyzing.*test\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
ok($o =~ /Uses Perl_newSViv instead of newSViv/);
$o = ppport(qw(--quiet --nochanges));
my $o = ppport(qw(--copy=a));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
$o = ppport(qw(--copy=b --cplusplus));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*FooBar\.xs/mi);
ok($o =~ /Analyzing.*FooBar\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o !~ /^Looks good/m);
ok($o =~ /^Uses grok_bin/m);
ok($o =~ /^Scanning.*sub.*third\.c/mi);
ok($o =~ /Analyzing.*sub.*third\.c/mi);
ok($o !~ /^Scanning.*foobar/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
---------------------------- First.xs -----------------------------------------
ok($o =~ /^Scanning.*\Q$_\E/mi);
ok($o =~ /Analyzing.*\Q$_\E/i);
}
-ok(matches($o, '^Scanning', 'm'), 6);
+is(matches($o, '^Scanning', 'm'), 6);
-ok(matches($o, '^Writing copy of', 'm'), 5);
+is(matches($o, '^Writing copy of', 'm'), 5);
ok(!-e "mod5.cf");
for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
-ok(matches($o, '^Looks good', 'm'), 2);
+is(matches($o, '^Looks good', 'm'), 2);
---------------------------- FooBar.xs ----------------------------------------
my $o = ppport(qw(--api-info=INT2PTR));
my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{INT2PTR});
-ok(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
-ok(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
+is(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
+is(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
$o = ppport(qw(--api-info=Zero));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{Zero});
-ok(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
+is(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
$o = ppport(qw(--api-info=/Zero/));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 2, "found 2 keys");
+is(scalar keys %found, 2, "found 2 keys");
ok(exists $found{Zero});
ok(exists $found{ZeroD});
$p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{call_pv});
ok(not ref $p{call_pv});
ok(exists $p{grok_bin});
-ok(ref $p{grok_bin}, 'HASH');
-ok(scalar keys %{$p{grok_bin}}, 2);
+is(ref $p{grok_bin}, 'HASH');
+is(scalar keys %{$p{grok_bin}}, 2);
ok($p{grok_bin}{explicit});
ok($p{grok_bin}{depend});
ok(exists $p{gv_stashpvn});
-ok(ref $p{gv_stashpvn}, 'HASH');
-ok(scalar keys %{$p{gv_stashpvn}}, 2);
+is(ref $p{gv_stashpvn}, 'HASH');
+is(scalar keys %{$p{gv_stashpvn}}, 2);
ok($p{gv_stashpvn}{depend});
ok($p{gv_stashpvn}{hint});
ok(exists $p{sv_catpvf_mg});
-ok(ref $p{sv_catpvf_mg}, 'HASH');
-ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
+is(ref $p{sv_catpvf_mg}, 'HASH');
+is(scalar keys %{$p{sv_catpvf_mg}}, 2);
ok($p{sv_catpvf_mg}{explicit});
ok($p{sv_catpvf_mg}{depend});
ok(exists $p{PL_signals});
-ok(ref $p{PL_signals}, 'HASH');
-ok(scalar keys %{$p{PL_signals}}, 1);
+is(ref $p{PL_signals}, 'HASH');
+is(scalar keys %{$p{PL_signals}}, 1);
ok($p{PL_signals}{explicit});
===============================================================================
$p{$name} = $ver;
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{utf8_distance});
-ok($p{utf8_distance}, '5.6.0');
+is($p{utf8_distance}, '5.6.0');
ok(exists $p{save_generic_svref});
-ok($p{save_generic_svref}, '5.005_03');
+is($p{save_generic_svref}, '5.005_03');
===============================================================================
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
-ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
-ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
+is(matches($o, '^\|\s+foo\.o', 'mi'), 1);
+is(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.o/mi);
ok($o =~ /^Scanning.*Makefile/mi);
ok($o =~ /Analyzing.*Makefile/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
-ok(matches($o, 'Analyzing', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, 'Analyzing', 'm'), 3);
---------------------------- foo.cpp ------------------------------------------
my @r;
@r = &Devel::PPPort::pv_pretty();
-ok($r[0], $r[1]);
-ok($r[0], "foobarbaz");
-ok($r[2], $r[3]);
-ok($r[2], '<leftpv_p\retty\nright>');
-ok($r[4], $r[5]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
-ok($r[6], $r[7]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+is($r[0], $r[1]);
+is($r[0], "foobarbaz");
+is($r[2], $r[3]);
+is($r[2], '<leftpv_p\retty\nright>');
+is($r[4], $r[5]);
+if(ord("A") == 65) {
+ is($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
+is($r[6], $r[7]);
+if(ord("A") == 65) {
+ is($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
@r = &Devel::PPPort::pv_display();
-ok($r[0], $r[1]);
-ok($r[0], '"foob\0rbaz"\0');
-ok($r[2], $r[3]);
+is($r[0], $r[1]);
+is($r[0], '"foob\0rbaz"\0');
+is($r[2], $r[3]);
ok($r[2] eq '"pv_di"...\0' ||
$r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
my $x = 'foo';
-ok(Devel::PPPort::newSVpvs(), "newSVpvs");
-ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
-ok(Devel::PPPort::newSVpvs_share(), 3);
+is(Devel::PPPort::newSVpvs(), "newSVpvs");
+is(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
+is(Devel::PPPort::newSVpvs_share(), 3);
Devel::PPPort::sv_catpvs($x);
-ok($x, "foosv_catpvs");
+is($x, "foosv_catpvs");
Devel::PPPort::sv_setpvs($x);
-ok($x, "sv_setpvs");
+is($x, "sv_setpvs");
my %h = ('hv_fetchs' => 42);
Devel::PPPort::hv_stores(\%h, 4711);
-ok(scalar keys %h, 2);
+is(scalar keys %h, 2);
ok(exists $h{'hv_stores'});
-ok($h{'hv_stores'}, 4711);
-ok(Devel::PPPort::hv_fetchs(\%h), 42);
-ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
+is($h{'hv_stores'}, 4711);
+is(Devel::PPPort::hv_fetchs(\%h), 42);
+is(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
-ok(Devel::PPPort::get_cvs(), 3);
+is(Devel::PPPort::get_cvs(), 3);
=tests plan => 1
-ok(&Devel::PPPort::newSVpvn_share(), 6);
+is(&Devel::PPPort::newSVpvn_share(), 6);
=tests plan => 2
my($l, $s) = Devel::PPPort::my_snprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
=tests plan => 2
my($l, $s) = Devel::PPPort::my_sprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
ok(@e == @r);
for (0 .. $#e) {
- ok($r[$_], $e[$_]);
+ is($r[$_], $e[$_]);
}
$h{foo} = 'foo-';
$h{bar} = '';
-ok(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
-ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
-ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+is(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
&Devel::PPPort::sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
&Devel::PPPort::sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
+is($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
+is($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
+is($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
=tests plan => 2
-ok(&Devel::PPPort::no_THX_arg("42"), 43);
+is(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
# skip tests on 5.6.0 and earlier, plus 7.0
if ("$]" <= '5.006' || "$]" == '5.007' ) {
- for (1..93) {
- skip 'skip: broken utf8 support', 0;
- }
+ skip 'skip: broken utf8 support', 93;
exit;
}
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
+is(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
-ok(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
+is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6));
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100));
if ("$]" < '5.006') {
- for (1 ..9) {
- ok(1, 1)
- }
+ skip("Perl version too early", 9);
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
- ok(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
- ok(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
+ is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
+ is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
+ is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
if (ord("A") != 65) {
- ok(1, 1)
+ skip("Test not valid on EBCDIC", 1)
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
+ is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
}
}
if ("$]" < '5.008') {
- for (1 ..3) {
- ok(1, 1)
- }
+ skip("Perl version too early", 3);
}
else {
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
}
my $ret = &Devel::PPPort::utf8_to_uvchr("A");
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr("\0");
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
if (ord("A") != 65) { # tests not valid for EBCDIC
- for (1 .. (2 + 4 + (7 * 5))) {
- ok(1, 1);
- }
+ skip("Perl version too early", 1 .. (2 + 4 + (7 * 5)));
}
else {
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
- ok($ret->[0], 0x100);
- ok($ret->[1], 2);
+ is($ret->[0], 0x100);
+ is($ret->[1], 2);
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_; };
{
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0);
- ok($ret->[1], -1);
+ is($ret->[0], 0);
+ is($ret->[1], -1);
BEGIN { 'warnings'->unimport() if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0xFFFD);
- ok($ret->[1], 1);
+ is($ret->[0], 0xFFFD);
+ is($ret->[1], 1);
}
my @buf_tests = (
use vars '%Config';
if ($Config{ccflags} =~ /-DDEBUGGING/) {
shift @buf_tests;
- for (1..5) {
- ok(1, 1);
- }
+ skip("Test not valid on DEBUGGING builds", 5);
}
my $test;
undef @warnings;
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0, "returned value $display; warnings enabled");
- ok($ret->[1], -1, "returned length $display; warnings enabled");
+ is($ret->[0], 0, "returned value $display; warnings enabled");
+ is($ret->[1], -1, "returned length $display; warnings enabled");
my $all_warnings = join "; ", @warnings;
my $contains = grep { $_ =~ $warning } $all_warnings;
- ok($contains, 1, $display
+ is($contains, 1, $display
. "; Got: '$all_warnings', which should contain '$warning'");
undef @warnings;
BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
- ok($ret->[1], $test->{'no_warnings_returned_length'},
+ is($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
+ is($ret->[1], $test->{'no_warnings_returned_length'},
"returned length $display; warnings disabled");
}
}
if ("$]" ge '5.008') {
BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
- ok(Devel::PPPort::sv_len_utf8("aščť"), 4);
- ok(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
my $str = "áíé";
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
tie my $scalar, 'TieScalarCounter', "é";
- ok(tied($scalar)->{fetch}, 0);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 2);
- ok(tied($scalar)->{fetch}, 1);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 3);
- ok(tied($scalar)->{fetch}, 2);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
+ is(tied($scalar)->{fetch}, 0);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 2);
+ is(tied($scalar)->{fetch}, 1);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 3);
+ is(tied($scalar)->{fetch}, 2);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
} else {
- for (1..23) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 23;
}
package TieScalarCounter;
BEGIN { require warnings if "$]" > '5.006' }
-ok(&Devel::PPPort::sv_setuv(42), 42);
-ok(&Devel::PPPort::newSVuv(123), 123);
-ok(&Devel::PPPort::sv_2uv("4711"), 4711);
-ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
-ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
-ok(&Devel::PPPort::XSRETURN_UV(), 42);
-ok(&Devel::PPPort::PUSHu(), 42);
-ok(&Devel::PPPort::XPUSHu(), 43);
-ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
+is(&Devel::PPPort::sv_setuv(42), 42);
+is(&Devel::PPPort::newSVuv(123), 123);
+is(&Devel::PPPort::sv_2uv("4711"), 4711);
+is(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+is(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+is(&Devel::PPPort::XSRETURN_UV(), 42);
+is(&Devel::PPPort::PUSHu(), 42);
+is(&Devel::PPPort::XPUSHu(), 43);
+is(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
ok(!defined(&Devel::PPPort::PL_sv_undef()));
ok(&Devel::PPPort::PL_sv_yes());
ok(!&Devel::PPPort::PL_sv_no());
-ok(&Devel::PPPort::PL_na("abcd"), 4);
-ok(&Devel::PPPort::PL_Sv(), "mhx");
+is(&Devel::PPPort::PL_na("abcd"), 4);
+is(&Devel::PPPort::PL_Sv(), "mhx");
ok(defined &Devel::PPPort::PL_tokenbuf());
ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
-ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
+is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
for (&Devel::PPPort::other_variables()) {
ok($_ != 0);
else {
ok(@w == 0);
}
- ok($fail, 0);
+ is($fail, 0);
}
ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
eval { &Devel::PPPort::no_dummy_parser_vars(0) };
if ("$]" < 5.009005) {
- ok($@, '');
+ is($@, '');
}
else {
if ($@) {
$warning = '';
Devel::PPPort::ckWARN();
-ok($warning, '');
+is($warning, '');
$^W = 1;
G_NOARGS # T
gp_free # T
gp_ref # T
+G_RETHROW # T
grok_bin # T
grok_hex # T
grok_number # T
SvEND # T
sv_eq # T
SVf # T
+SVfARG # T
sv_free # T
SVf_UTF8 # T
SvGETMAGIC # T
isUPPER_utf8_safe # U
isUPPER_uvchr # U
is_utf8_char # U
-is_utf8_mark # U
isWORDCHAR_LC_utf8_safe # U
isWORDCHAR_utf8_safe # U
isWORDCHAR_uvchr # U
av_arylen_p # U
ckwarn # U
ckwarn_d # U
-csighandler # E (Perl_csighandler)
dMULTICALL # E
doref # U
gv_const_sv # U
5.031007
-dMY_CXT_SV # E
-my_lstat # U (Perl_my_lstat)
-my_stat # U (Perl_my_stat)
-pack_cat # U (Perl_pack_cat)
-pad_compname_type # U (Perl_pad_compname_type)
+csighandler # E (Perl_csighandler)
+csighandler1 # U
+csighandler3 # E
+perly_sighandler # E
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
+is(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
ok(!defined Devel::PPPort::HvNAME_get({}));
-ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
-ok(Devel::PPPort::HvNAMELEN_get({}), 0);
+is(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
+is(Devel::PPPort::HvNAMELEN_get({}), 0);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my $mhx = "mhx";
-ok(&Devel::PPPort::SvPVbyte($mhx), 3);
+is(&Devel::PPPort::SvPVbyte($mhx), 3);
my $i = 42;
-ok(&Devel::PPPort::SvPV_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
+is(&Devel::PPPort::SvPV_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_force($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
my $str = "";
&Devel::PPPort::SvPV_force($str);
my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
-ok($str, "x"x80);
-ok($s2, "x"x80);
+is($str, "x"x80);
+is($s2, "x"x80);
ok($before < 81);
-ok($after, 81);
+is($after, 81);
$str = "x"x400;
&Devel::PPPort::SvPV_force($str);
($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
-ok($str, "x"x40);
-ok($s2, "x"x40);
+is($str, "x"x40);
+is($s2, "x"x40);
ok($before > 41);
-ok($after, 41);
+is($after, 41);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my $foo = 5;
-ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
-ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
-ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
+is(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
+is(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
+is(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
my $bar = [];
bless $bar, 'foo';
-ok($bar->x(), 'foobar');
+is($bar->x(), 'foobar');
Devel::PPPort::TestSvSTASH_set($bar, 'bar');
-ok($bar->x(), 'hacker');
+is($bar->x(), 'hacker');
if ( "$]" < '5.007003' ) {
- for (1..10) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 10;
} else {
ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL());
tie my $scalar, 'TieScalarCounter', 'string';
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $copy = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $copy2 = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok $copy2, 'string';
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is $copy2, 'string';
}
package TieScalarCounter;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-sub eq_array
-{
- my($a, $b) = @_;
- join(':', @$a) eq join(':', @$b);
-}
-
sub f
{
shift;
ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
};
-ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
-ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+is(&Devel::PPPort::eval_pv('f()', 0), 'y');
+is(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
-ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
+is(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
Devel::PPPort::load_module(0, "less", undef);
-ok(defined $::{'less::'}, 1, "Have now loaded less");
+is(defined $::{'less::'}, 1, "Have now loaded less");
ok(eval { Devel::PPPort::eval_pv('die', 0); 1 });
ok(!eval { Devel::PPPort::eval_pv('die', 1); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
ok(eval { Devel::PPPort::eval_sv('die', 0); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
{
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
- if (28) {
+ if (8) {
load();
- plan(tests => 28);
+ plan(tests => 8);
}
}
$package = &Devel::PPPort::CopSTASHPV();
}
print "# $package\n";
-ok($package, "MyPackage");
+is($package, "MyPackage");
my $file = &Devel::PPPort::CopFILE();
print "# $file\n";
BEGIN {
if ("$]" < 5.006000) {
- # Skip
- for (1..28) {
- ok(1, 1);
- }
+ skip("Perl version too early", 8);
exit;
}
}
) {
my ($sub, $arg, @want) = @$_;
my @got = $sub->($arg);
- ok(@got, @want);
- for (0..$#want) {
- ok($got[$_], $want[$_]);
- }
+ ok(eq_array(\@got, \@want));
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(0) };
-ok($@, '');
+is($@, '');
ok(defined $rv);
-ok($rv, 42);
-ok($Devel::PPPort::exception_caught, 0);
+is($rv, 42);
+is($Devel::PPPort::exception_caught, 0);
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(1) };
-ok($@, "boo\n");
+is($@, "boo\n");
ok(not defined $rv);
-ok($Devel::PPPort::exception_caught, 1);
+is($Devel::PPPort::exception_caught, 1);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
use Config;
if ("$]" < '5.004') {
- for (1..5) {
- skip 'skip: No newSVpvf support', 0;
- }
+ skip 'skip: No newSVpvf support', 5;
exit;
}
eval { Devel::PPPort::croak_NVgf($num) };
ok($@ =~ /^1.1234567890/);
-ok(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
-ok(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
+is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
+is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
my $ivsize = $Config::Config{ivsize};
my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0;
my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0;
if ($ivmax == 0) {
- for (1..2) {
- skip 'skip: unknown ivsize', 0;
- }
+ skip 'skip: unknown ivsize', 2;
} else {
- ok(Devel::PPPort::sprintf_ivmax(), $ivmax);
- ok(Devel::PPPort::sprintf_uvmax(), $uvmax);
+ is(Devel::PPPort::sprintf_ivmax(), $ivmax);
+ is(Devel::PPPort::sprintf_uvmax(), $uvmax);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::grok_number("42"), 42);
+is(&Devel::PPPort::grok_number("42"), 42);
ok(!defined(&Devel::PPPort::grok_number("A")));
-ok(&Devel::PPPort::grok_bin("10000001"), 129);
-ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::grok_oct("377"), 255);
+is(&Devel::PPPort::grok_bin("10000001"), 129);
+is(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::grok_oct("377"), 255);
-ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+is(&Devel::PPPort::Perl_grok_number("42"), 42);
ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
-ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
-ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+is(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+is(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::Perl_grok_oct("377"), 255);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::GvSVn(), 1);
+is(Devel::PPPort::GvSVn(), 1);
-ok(Devel::PPPort::isGV_with_GP(), 2);
+is(Devel::PPPort::isGV_with_GP(), 2);
-ok(Devel::PPPort::get_cvn_flags(), 3);
+is(Devel::PPPort::get_cvn_flags(), 3);
-ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
+is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
ok($::{sanity_check});
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
-ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
# Find proper magic
ok(my $obj1 = Devel::PPPort->new_with_mg());
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Find with no magic
my $obj = bless {}, 'Fake::Class';
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Find with other magic (not the magic we are looking for)
ok($obj = Devel::PPPort->new_with_other_mg());
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Okay, attempt to remove magic that isn't there
Devel::PPPort::remove_other_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Remove magic that IS there
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
# Removing when no magic present
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
use Tie::Hash;
my %h;
$h{bar} = '';
&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
-ok($h{foo}, 'foobar');
+is($h{foo}, 'foobar');
&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
-ok($h{bar}, 'baz');
+is($h{bar}, 'baz');
&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
-ok($h{foo}, 'foobar42');
+is($h{foo}, 'foobar42');
&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
-ok($h{bar}, 42);
+is($h{bar}, 42);
&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);
&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
-ok($h{mhx}, 'mhx');
+is($h{mhx}, 'mhx');
&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
-ok($h{mhx}, 'Marcus');
+is($h{mhx}, 'Marcus');
&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
-ok($h{sv}, 'SV');
+is($h{sv}, 'SV');
&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
-ok($h{sv}, 4711);
+is($h{sv}, 4711);
&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
-ok($h{sv}, 'Perl');
+is($h{sv}, 'Perl');
# v1 is treated as a bareword in older perls...
my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] };
ok($foo eq 'bar');
if ( "$]" < '5.007003' ) {
- for (1..22) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 22;
} else {
tie my $scalar, 'TieScalarCounter', 10;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvIV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvUV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvNV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvIV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvUV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvNV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
ok Devel::PPPort::magic_SvTRUE_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $object = OverloadedObject->new('string', 5.5, 0);
- ok Devel::PPPort::magic_SvIV_nomg($object), 5;
- ok Devel::PPPort::magic_SvUV_nomg($object), 5;
- ok Devel::PPPort::magic_SvNV_nomg($object), 5.5;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
+ is Devel::PPPort::magic_SvIV_nomg($object), 5;
+ is Devel::PPPort::magic_SvUV_nomg($object), 5;
+ is Devel::PPPort::magic_SvNV_nomg($object), 5.5;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
ok !Devel::PPPort::magic_SvTRUE_nomg($object);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::checkmem(), 6);
+is(Devel::PPPort::checkmem(), 6);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") };
-ok $@, "\xE1\n";
-ok $die, "\xE1\n";
+is $@, "\xE1\n";
+is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(10) };
-ok $@ =~ /^10 at $0 line /;
-ok $die =~ /^10 at $0 line /;
+ok $@ =~ /^10 at \Q$0\E line /;
+ok $die =~ /^10 at \Q$0\E line /;
undef $die;
$@ = 'should not be visible (1)';
$@ = 'should not be visible (2)';
Devel::PPPort::croak_sv('');
};
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv($@)
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv($@)
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv_errsv()
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv_errsv()
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv_with_counter("message\n") };
-ok $@, "message\n";
-ok Devel::PPPort::get_counter(), 1;
+is $@, "message\n";
+is Devel::PPPort::get_counter(), 1;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv('') };
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1") };
-ok $@ =~ /^\xE1 at $0 line /;
-ok $die =~ /^\xE1 at $0 line /;
+ok $@ =~ /^\xE1 at \Q$0\E line /;
+ok $die =~ /^\xE1 at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
-ok $@ =~ /^\xC3\xA1 at $0 line /;
-ok $die =~ /^\xC3\xA1 at $0 line /;
+ok $@ =~ /^\xC3\xA1 at \Q$0\E line /;
+ok $die =~ /^\xC3\xA1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1\n");
-ok $warn, "\xE1\n";
+is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(10);
-ok $warn =~ /^10 at $0 line /;
+ok $warn =~ /^10 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv('');
-ok $warn =~ /^ at $0 line /;
+ok $warn =~ /^ at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1");
-ok $warn =~ /^\xE1 at $0 line /;
+ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
-ok $warn =~ /^\xC3\xA1 at $0 line /;
+ok $warn =~ /^\xC3\xA1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
+is Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
+is Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
-ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at $0 line /;
+ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv('', 0) =~ /^ at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at $0 line /;
+ok Devel::PPPort::mess_sv('', 0) =~ /^ at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at \Q$0\E line /;
if ("$]" >= '5.006') {
BEGIN { if ("$]" >= '5.006' && "$]" < '5.008') { require utf8; utf8->import(); } }
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@, "\x{100}\n";
+ is $@, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die, "\x{100}\n";
+ is $die, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@ =~ /^\x{100} at $0 line /;
+ ok $@ =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die =~ /^\x{100} at $0 line /;
+ ok $die =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
undef $warn;
Devel::PPPort::warn_sv("\x{100}\n");
- ok $warn, "\x{100}\n";
+ is $warn, "\x{100}\n";
undef $warn;
Devel::PPPort::warn_sv("\x{100}");
- ok (my $tmp = $warn) =~ /^\x{100} at $0 line /;
+ ok (my $tmp = $warn) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..2) {
- skip 'skip: broken utf8 support in warn hook', 0;
- }
+ skip 'skip: broken utf8 support in warn hook', 2;
}
- ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
+ is Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
+ is Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
- ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at $0 line /;
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at $0 line /;
+ ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at \Q$0\E line /;
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..12) {
- skip 'skip: no utf8 support', 0;
- }
+ skip 'skip: no utf8 support', 12;
}
if (ord('A') != 65) {
- for (1..24) {
- skip 'skip: no ASCII support', 0;
- }
+ skip 'skip: no ASCII support', 24;
} elsif ( "$]" >= '5.008'
&& "$]" != '5.013000' # Broken in these ranges
&& ! ("$]" >= '5.011005' && "$]" <= '5.012000'))
{
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
- ok $@, "\xE1\n";
- ok $die, "\xE1\n";
+ is $@, "\xE1\n";
+ is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
- ok $@ =~ /^\xE1 at $0 line /;
- ok $die =~ /^\xE1 at $0 line /;
+ ok $@ =~ /^\xE1 at \Q$0\E line /;
+ ok $die =~ /^\xE1 at \Q$0\E line /;
{
undef $die;
my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
- ok $@, $expect;
- ok $die, $expect;
+ is $@, $expect;
+ is $die, $expect;
}
{
undef $die;
- my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
ok $@ =~ $expect;
ok $die =~ $expect;
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
- ok $warn, "\xE1\n";
+ is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
- ok $warn =~ /^\xE1 at $0 line /;
+ ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1\n");
- ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';
+ is $warn, eval '"\N{U+C3}\N{U+A1}\n"';
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
- ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
if ("$]" < '5.004') {
- for (1..8) {
- skip 'skip: no support for mess_sv', 0;
- }
+ skip 'skip: no support for mess_sv', 8;
}
else {
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at $0 line /';
+ ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
- ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
}
} else {
- for (1..24) {
- skip 'skip: no support for \N{U+..} syntax', 0;
- }
+ skip 'skip: no support for \N{U+..} syntax', 24;
}
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
ok $@ == $obj;
ok $die == $obj;
} else {
- for (1..12) {
- skip 'skip: no support for exceptions', 0;
- }
+ skip 'skip: no support for exceptions', 12;
}
ok !defined eval { Devel::PPPort::croak_no_modify() };
-ok $@ =~ /^Modification of a read-only value attempted at $0 line /;
+ok $@ =~ /^Modification of a read-only value attempted at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_memory_wrap() };
-ok $@ =~ /^panic: memory wrap at $0 line /;
+ok $@ =~ /^panic: memory wrap at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_xs_usage("params") };
-ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at $0 line /;
+ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at \Q$0\E line /;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
-ok(&Devel::PPPort::DEFSV(), "Fred");
-ok(&Devel::PPPort::UNDERBAR(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::UNDERBAR(), "Fred");
if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) {
eval q{
no warnings "deprecated";
no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
my $_ = "Tony";
- ok(&Devel::PPPort::DEFSV(), "Fred");
- ok(&Devel::PPPort::UNDERBAR(), "Tony");
+ is(&Devel::PPPort::DEFSV(), "Fred");
+ is(&Devel::PPPort::UNDERBAR(), "Tony");
};
}
else {
my @r = &Devel::PPPort::DEFSV_modify();
ok(@r == 3);
-ok($r[0], 'Fred');
-ok($r[1], 'DEFSV');
-ok($r[2], 'Fred');
+is($r[0], 'Fred');
+is($r[1], 'DEFSV');
+is($r[2], 'Fred');
-ok(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
eval { 1 };
ok(!&Devel::PPPort::ERRSV());
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
-ok(Devel::PPPort::dXSTARG(42), 43);
-ok(Devel::PPPort::dAXMARK(4711), 4710);
+is(Devel::PPPort::dXSTARG(42), 43);
+is(Devel::PPPort::dAXMARK(4711), 4710);
-ok(Devel::PPPort::prepush(), 42);
+is(Devel::PPPort::prepush(), 42);
-ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
-ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
+is(join(':', Devel::PPPort::xsreturn(0)), 'test1');
+is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
-ok(Devel::PPPort::PERL_ABS(42), 42);
-ok(Devel::PPPort::PERL_ABS(-13), 13);
+is(Devel::PPPort::PERL_ABS(42), 42);
+is(Devel::PPPort::PERL_ABS(-13), 13);
-ok(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
-ok(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
+is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
+is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
-ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
+is(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
-ok(&Devel::PPPort::ptrtests(), 63);
+is(&Devel::PPPort::ptrtests(), 63);
-ok(&Devel::PPPort::OpSIBLING_tests(), 0);
+is(&Devel::PPPort::OpSIBLING_tests(), 0);
if (ivers($]) >= ivers(5.9)) {
eval q{
- ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
- ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
+ is(&Devel::PPPort::check_HeUTF8("hello"), "norm");
+ is(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
};
} else {
- ok(1, 1);
- ok(1, 1);
+ skip("Too early perl version", 2);
}
@r = &Devel::PPPort::check_c_array();
-ok($r[0], 4);
-ok($r[1], "13");
+is($r[0], 4);
+is($r[1], "13");
ok(!Devel::PPPort::SvRXOK(""));
ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
if (ivers($]) < ivers(5.5)) {
- skip 'no qr// objects in this perl', 0;
- skip 'no qr// objects in this perl', 0;
+ skip 'no qr// objects in this perl', 2;
} else {
my $qr = eval 'qr/./';
ok(Devel::PPPort::SvRXOK($qr));
? 0 # Fail on non-ASCII unless unicode
: ($types{"$native:$class"} || 0);
if (ivers($]) < ivers(5.6) && $suffix eq '_uvchr') {
- skip("No UTF-8 on this perl", 0);
+ skip("No UTF-8 on this perl", 1);
next;
}
my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
my $is = eval $eval_string || 0;
die "eval 'For $i: $eval_string' gave $@" if $@;
- ok($is, $should_be, "'$eval_string'");
+ is($is, $should_be, "'$eval_string'");
}
}
my $utf8;
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
else {
$utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
my $should_be = $types{"$native:$class"} || 0;
+ local $SIG{__WARN__} = sub {};
my $eval_string = "$fcn(\"$utf8\", 0)";
my $is = eval $eval_string || 0;
die "eval 'For $i, $eval_string' gave $@" if $@;
- ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
}
# And for the high code points, test that a too short malformation (the
# -1) causes it to fail
if ($i > 255) {
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
elsif (ivers($]) >= ivers(5.25.9)) {
- skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
+ skip("Prints an annoying error message that khw doesn't know how to easily suppress", 1);
}
else {
my $eval_string = "$fcn(\"$utf8\", -1)";
my $is = eval "no warnings; $eval_string" || 0;
die "eval '$eval_string' gave $@" if $@;
- ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
}
}
}
$skip = "Can't do uvchr on a multi-char string";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
if ($is_cp) {
my $ret = eval "Devel::PPPort::$fcn($original)";
my $fail = $@; # Have to save $@, as it gets destroyed
- ok ($fail, "", "$fcn($original) didn't fail");
+ is ($fail, "", "$fcn($original) didn't fail");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
$skip = "Don't try to test shortened single bytes";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
my $fcn = "to${name}_utf8_safe";
my $ret = eval "no warnings; $eval_string" || 0;
my $fail = $@; # Have to save $@, as it gets destroyed
if ($truncate == 0) {
- ok ($fail, "", "Didn't fail on full length input");
+ is ($fail, "", "Didn't fail on full length input");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
else {
- ok ($fail, eval 'qr/Malformed UTF-8 character/',
+ is ($fail, eval 'qr/Malformed UTF-8 character/',
"Gave appropriate error for short char: $original");
- for (1..3) {
- skip("Expected failure means remaining tests for"
- . " this aren't relevant", 0);
- }
+ skip("Expected failure means remaining tests for"
+ . " this aren't relevant", 3);
}
}
}
}
}
-ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
-ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
+is(&Devel::PPPort::av_top_index([1,2,3]), 2);
+is(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
&Devel::PPPort::call_newCONSTSUB_1();
-ok(&Devel::PPPort::test_value_1(), 1);
+is(&Devel::PPPort::test_value_1(), 1);
&Devel::PPPort::call_newCONSTSUB_2();
-ok(&Devel::PPPort::test_value_2(), 2);
+is(&Devel::PPPort::test_value_2(), 2);
&Devel::PPPort::call_newCONSTSUB_3();
-ok(&Devel::PPPort::test_value_3(), 3);
+is(&Devel::PPPort::test_value_3(), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
-ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+is(&Devel::PPPort::newRV_inc_REFCNT, 1);
+is(&Devel::PPPort::newRV_noinc_REFCNT, 1);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::newSV_type(), 4);
+is(Devel::PPPort::newSV_type(), 4);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_flags();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_utf8();
ok(@s == 1);
-ok($s[0], "test");
+is($s[0], "test");
if ("$]" >= 5.008001) {
require utf8;
ok(utf8::is_utf8($s[0]));
}
else {
- skip("skip: no is_utf8()", 0);
+ skip("skip: no is_utf8()", 1);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
for (@pods) {
print "# checking $_\n";
if ($reason) {
- skip("skip: $reason", 0);
+ skip("skip: $reason", 1);
}
else {
pod_file_ok($_);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 238) {
- skip("skip: SKIP_SLOW_TESTS", 0);
- }
+ skip("skip: SKIP_SLOW_TESTS", 238);
exit 0;
}
}
ok(&Devel::PPPort::WriteFile("ppport.h"));
# Check GetFileContents()
-ok(-e "ppport.h", 1);
+is(-e "ppport.h", 1);
my $data;
}
close(F);
-ok(Devel::PPPort::GetFileContents("ppport.h"), $data);
-ok(Devel::PPPort::GetFileContents(), $data);
+is(Devel::PPPort::GetFileContents("ppport.h"), $data);
+is(Devel::PPPort::GetFileContents(), $data);
sub comment
{
$err =~ s/^/# *** /mg;
print "# *** ERROR ***\n$err\n";
}
- ok($@, '');
+ is($@, '');
for (keys %{$t->{files}}) {
unlink $_ or die "unlink('$_'): $!\n";
$o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*test\.xs/mi);
ok($o =~ /Analyzing.*test\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
ok($o =~ /Uses Perl_newSViv instead of newSViv/);
$o = ppport(qw(--quiet --nochanges));
my $o = ppport(qw(--copy=a));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
$o = ppport(qw(--copy=b --cplusplus));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*FooBar\.xs/mi);
ok($o =~ /Analyzing.*FooBar\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o !~ /^Looks good/m);
ok($o =~ /^Uses grok_bin/m);
ok($o =~ /^Scanning.*sub.*third\.c/mi);
ok($o =~ /Analyzing.*sub.*third\.c/mi);
ok($o !~ /^Scanning.*foobar/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
---------------------------- First.xs -----------------------------------------
ok($o =~ /^Scanning.*\Q$_\E/mi);
ok($o =~ /Analyzing.*\Q$_\E/i);
}
-ok(matches($o, '^Scanning', 'm'), 6);
+is(matches($o, '^Scanning', 'm'), 6);
-ok(matches($o, '^Writing copy of', 'm'), 5);
+is(matches($o, '^Writing copy of', 'm'), 5);
ok(!-e "mod5.cf");
for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
-ok(matches($o, '^Looks good', 'm'), 2);
+is(matches($o, '^Looks good', 'm'), 2);
---------------------------- FooBar.xs ----------------------------------------
my $o = ppport(qw(--api-info=INT2PTR));
my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{INT2PTR});
-ok(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
-ok(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
+is(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
+is(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
$o = ppport(qw(--api-info=Zero));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{Zero});
-ok(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
+is(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
$o = ppport(qw(--api-info=/Zero/));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 2, "found 2 keys");
+is(scalar keys %found, 2, "found 2 keys");
ok(exists $found{Zero});
ok(exists $found{ZeroD});
$p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{call_pv});
ok(not ref $p{call_pv});
ok(exists $p{grok_bin});
-ok(ref $p{grok_bin}, 'HASH');
-ok(scalar keys %{$p{grok_bin}}, 2);
+is(ref $p{grok_bin}, 'HASH');
+is(scalar keys %{$p{grok_bin}}, 2);
ok($p{grok_bin}{explicit});
ok($p{grok_bin}{depend});
ok(exists $p{gv_stashpvn});
-ok(ref $p{gv_stashpvn}, 'HASH');
-ok(scalar keys %{$p{gv_stashpvn}}, 2);
+is(ref $p{gv_stashpvn}, 'HASH');
+is(scalar keys %{$p{gv_stashpvn}}, 2);
ok($p{gv_stashpvn}{depend});
ok($p{gv_stashpvn}{hint});
ok(exists $p{sv_catpvf_mg});
-ok(ref $p{sv_catpvf_mg}, 'HASH');
-ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
+is(ref $p{sv_catpvf_mg}, 'HASH');
+is(scalar keys %{$p{sv_catpvf_mg}}, 2);
ok($p{sv_catpvf_mg}{explicit});
ok($p{sv_catpvf_mg}{depend});
ok(exists $p{PL_signals});
-ok(ref $p{PL_signals}, 'HASH');
-ok(scalar keys %{$p{PL_signals}}, 1);
+is(ref $p{PL_signals}, 'HASH');
+is(scalar keys %{$p{PL_signals}}, 1);
ok($p{PL_signals}{explicit});
===============================================================================
$p{$name} = $ver;
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{utf8_distance});
-ok($p{utf8_distance}, '5.6.0');
+is($p{utf8_distance}, '5.6.0');
ok(exists $p{save_generic_svref});
-ok($p{save_generic_svref}, '5.005_03');
+is($p{save_generic_svref}, '5.005_03');
===============================================================================
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
-ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
-ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
+is(matches($o, '^\|\s+foo\.o', 'mi'), 1);
+is(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.o/mi);
ok($o =~ /^Scanning.*Makefile/mi);
ok($o =~ /Analyzing.*Makefile/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
-ok(matches($o, 'Analyzing', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, 'Analyzing', 'm'), 3);
---------------------------- foo.cpp ------------------------------------------
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my @r;
@r = &Devel::PPPort::pv_pretty();
-ok($r[0], $r[1]);
-ok($r[0], "foobarbaz");
-ok($r[2], $r[3]);
-ok($r[2], '<leftpv_p\retty\nright>');
-ok($r[4], $r[5]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
-ok($r[6], $r[7]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+is($r[0], $r[1]);
+is($r[0], "foobarbaz");
+is($r[2], $r[3]);
+is($r[2], '<leftpv_p\retty\nright>');
+is($r[4], $r[5]);
+if(ord("A") == 65) {
+ is($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
+is($r[6], $r[7]);
+if(ord("A") == 65) {
+ is($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
@r = &Devel::PPPort::pv_display();
-ok($r[0], $r[1]);
-ok($r[0], '"foob\0rbaz"\0');
-ok($r[2], $r[3]);
+is($r[0], $r[1]);
+is($r[0], '"foob\0rbaz"\0');
+is($r[2], $r[3]);
ok($r[2] eq '"pv_di"...\0' ||
$r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my $x = 'foo';
-ok(Devel::PPPort::newSVpvs(), "newSVpvs");
-ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
-ok(Devel::PPPort::newSVpvs_share(), 3);
+is(Devel::PPPort::newSVpvs(), "newSVpvs");
+is(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
+is(Devel::PPPort::newSVpvs_share(), 3);
Devel::PPPort::sv_catpvs($x);
-ok($x, "foosv_catpvs");
+is($x, "foosv_catpvs");
Devel::PPPort::sv_setpvs($x);
-ok($x, "sv_setpvs");
+is($x, "sv_setpvs");
my %h = ('hv_fetchs' => 42);
Devel::PPPort::hv_stores(\%h, 4711);
-ok(scalar keys %h, 2);
+is(scalar keys %h, 2);
ok(exists $h{'hv_stores'});
-ok($h{'hv_stores'}, 4711);
-ok(Devel::PPPort::hv_fetchs(\%h), 42);
-ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
+is($h{'hv_stores'}, 4711);
+is(Devel::PPPort::hv_fetchs(\%h), 42);
+is(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
-ok(Devel::PPPort::get_cvs(), 3);
+is(Devel::PPPort::get_cvs(), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::newSVpvn_share(), 6);
+is(&Devel::PPPort::newSVpvn_share(), 6);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my($l, $s) = Devel::PPPort::my_snprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my($l, $s) = Devel::PPPort::my_sprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(@e == @r);
for (0 .. $#e) {
- ok($r[$_], $e[$_]);
+ is($r[$_], $e[$_]);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$h{foo} = 'foo-';
$h{bar} = '';
-ok(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
-ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
-ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+is(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
&Devel::PPPort::sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
&Devel::PPPort::sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
+is($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
+is($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
+is($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
-{
- my $__ntest;
- my $__total;
-
- sub plan {
- @_ == 2 or die "usage: plan(tests => count)";
- my $what = shift;
- $what eq 'tests' or die "cannot plan anything but tests";
- $__total = shift;
- defined $__total && $__total > 0 or die "need a positive number of tests";
- print "1..$__total\n";
- }
+#
+# t/test.pl - most of Test::More functionality without the fuss
- sub skip {
- my $reason = shift;
- ++$__ntest;
- print "ok $__ntest # skip: $reason\n"
- }
- sub ok ($;$$) {
- local($\,$,);
- my $ok = 0;
- my $result = shift;
- if (@_ == 0) {
- $ok = $result;
+# NOTE:
+#
+# Do not rely on features found only in more modern Perls here, as some CPAN
+# distributions copy this file and must operate on older Perls. Similarly, keep
+# things, simple as this may be run under fairly broken circumstances. For
+# example, increment ($x++) has a certain amount of cleverness for things like
+#
+# $x = 'zz';
+# $x++; # $x eq 'aaa';
+#
+# This stands more chance of breaking than just a simple
+#
+# $x = $x + 1
+#
+# In this file, we use the latter "Baby Perl" approach, and increment
+# will be worked over by t/op/inc.t
+
+$| = 1;
+$Level = 1;
+my $test = 1;
+my $planned;
+my $noplan;
+
+# This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
+$::IS_ASCII = ord 'A' == 65;
+$::IS_EBCDIC = ord 'A' == 193;
+
+$TODO = 0;
+$NO_ENDING = 0;
+$Tests_Are_Passing = 1;
+
+# Use this instead of print to avoid interference while testing globals.
+sub _print {
+ local($\, $", $,) = (undef, ' ', '') if "$]" >= 5.004;
+ print STDOUT @_;
+}
+
+sub _print_stderr {
+ local($\, $", $,) = (undef, ' ', '') if "$]" >= 5.004;
+ print STDERR @_;
+}
+
+sub plan {
+ my $n;
+ if (@_ == 1) {
+ $n = shift;
+ if ($n eq 'no_plan') {
+ undef $n;
+ $noplan = 1;
+ }
} else {
- $expected = shift;
- if (!defined $expected) {
- $ok = !defined $result;
- } elsif (!defined $result) {
- $ok = 0;
- } elsif (ref($expected) eq 'Regexp') {
- die "using regular expression objects is not backwards compatible";
- } else {
- $ok = $result eq $expected;
- }
+ my %plan = @_;
+ $plan{skip_all} and skip_all($plan{skip_all});
+ $n = $plan{tests};
}
- ++$__ntest;
- if ($ok) {
- print "ok $__ntest\n"
+ _print "1..$n\n" unless $noplan;
+ $planned = $n;
+}
+
+
+# Set the plan at the end. See Test::More::done_testing.
+sub done_testing {
+ my $n = $test - 1;
+ $n = shift if @_;
+
+ _print "1..$n\n";
+ $planned = $n;
+}
+
+
+END {
+ my $ran = $test - 1;
+ if (!$NO_ENDING) {
+ if (defined $planned && $planned != $ran) {
+ _print_stderr
+ "# Looks like you planned $planned tests but ran $ran.\n";
+ } elsif ($noplan) {
+ _print "1..$ran\n";
+ }
+ }
+}
+
+sub _diag {
+ return unless @_;
+ my @mess = _comment(@_);
+ $TODO ? _print(@mess) : _print_stderr(@mess);
+}
+
+# Use this instead of "print STDERR" when outputting failure diagnostic
+# messages
+sub diag {
+ _diag(@_);
+}
+
+# Use this instead of "print" when outputting informational messages
+sub note {
+ return unless @_;
+ _print( _comment(@_) );
+}
+
+sub _comment {
+ return map { /^#/ ? "$_\n" : "# $_\n" }
+ map { split /\n/ } @_;
+}
+
+sub _have_dynamic_extension {
+ my $extension = shift;
+ unless (eval {require Config; 1}) {
+ warn "test.pl had problems loading Config: $@";
+ return 1;
+ }
+ $extension =~ s!::!/!g;
+ return 1 if ($Config::Config{extensions} =~ /\b$extension\b/);
+}
+
+sub skip_all {
+ if (@_) {
+ _print "1..0 # Skip @_\n";
+ } else {
+ _print "1..0\n";
+ }
+ exit(0);
+}
+
+sub BAIL_OUT {
+ my ($reason) = @_;
+ _print("Bail out! $reason\n");
+ exit 255;
+}
+
+sub _ok {
+ my ($pass, $where, $name, @mess) = @_;
+ # Do not try to microoptimize by factoring out the "not ".
+ # VMS will avenge.
+ my $out;
+ if ($name) {
+ # escape out '#' or it will interfere with '# skip' and such
+ $name =~ s/#/\\#/g;
+ $out = $pass ? "ok $test - $name" : "not ok $test - $name";
+ } else {
+ $out = $pass ? "ok $test" : "not ok $test";
+ }
+
+ if ($TODO) {
+ $out = $out . " # TODO $TODO";
+ } else {
+ $Tests_Are_Passing = 0 unless $pass;
+ }
+
+ _print "$out\n";
+
+ if ($pass) {
+ note @mess; # Ensure that the message is properly escaped.
}
else {
- print "not ok $__ntest\n"
+ my $msg = "# Failed test $test - ";
+ $msg.= "$name " if $name;
+ $msg .= "$where\n";
+ _diag $msg;
+ _diag @mess;
}
+
+ $test = $test + 1; # don't use ++
+
+ return $pass;
+}
+
+sub _where {
+ my @caller = caller($Level);
+ return "at $caller[1] line $caller[2]";
+}
+
+sub ok ($@) {
+ my ($pass, $name, @mess) = @_;
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub _q {
+ my $x = shift;
+ return 'undef' unless defined $x;
+ my $q = $x;
+ $q =~ s/\\/\\\\/g;
+ $q =~ s/'/\\'/g;
+ return "'$q'";
+}
+
+sub _qq {
+ my $x = shift;
+ return defined $x ? '"' . display ($x) . '"' : 'undef';
+};
+
+# Support pre-5.10 Perls, for the benefit of CPAN dists that copy this file.
+# Note that chr(90) exists in both ASCII ("Z") and EBCDIC ("!").
+my $chars_template = defined(eval { pack "W*", 90 }) ? "W*" : "U*";
+eval 'sub re::is_regexp { ref($_[0]) eq "Regexp" }'
+ if !defined &re::is_regexp;
+
+# keys are the codes \n etc map to, values are 2 char strings such as \n
+my %backslash_escape;
+my $x;
+foreach $x (split //, 'nrtfa\\\'"') {
+ $backslash_escape{ord eval "\"\\$x\""} = "\\$x";
+}
+# A way to display scalars containing control characters and Unicode.
+# Trying to avoid setting $_, or relying on local $_ to work.
+sub display {
+ my @result;
+ my $x;
+ foreach $x (@_) {
+ if (defined $x and not ref $x) {
+ my $y = '';
+ my $c;
+ foreach $c (unpack($chars_template, $x)) {
+ if ($c > 255) {
+ $y = $y . sprintf "\\x{%x}", $c;
+ } elsif ($backslash_escape{$c}) {
+ $y = $y . $backslash_escape{$c};
+ } else {
+ my $z = chr $c; # Maybe we can get away with a literal...
+ my $is_printable = ($::IS_ASCII)
+ ? $c >= ord(" ") && $c <= ord("~")
+ : $z !~ /[^[:^print:][:^ascii:]]/;
+ # /[::]/ was introduced before non-ASCII support
+ # The pattern above is equivalent (by de Morgan's
+ # laws) to:
+ # $z !~ /(?[ [:print:] & [:ascii:] ])/
+ # or, $z is not an ascii printable character
+
+ unless ($is_printable) {
+ # Use octal for characters with small ordinals that
+ # are traditionally expressed as octal: the controls
+ # below space, which on EBCDIC are almost all the
+ # controls, but on ASCII don't include DEL nor the C1
+ # controls.
+ if ($c < ord " ") {
+ $z = sprintf "\\%03o", $c;
+ } else {
+ $z = sprintf "\\x{%x}", $c;
+ }
+ }
+ $y = $y . $z;
+ }
+ }
+ $x = $y;
+ }
+ return $x unless wantarray;
+ push @result, $x;
+ }
+ return @result;
+}
+
+sub is ($$@) {
+ my ($got, $expected, $name, @mess) = @_;
+
+ my $pass;
+ if( !defined $got || !defined $expected ) {
+ # undef only matches undef
+ $pass = !defined $got && !defined $expected;
+ }
+ else {
+ $pass = $got eq $expected;
+ }
+
+ unless ($pass) {
+ unshift(@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)."\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub isnt ($$@) {
+ my ($got, $isnt, $name, @mess) = @_;
+
+ my $pass;
+ if( !defined $got || !defined $isnt ) {
+ # undef only matches undef
+ $pass = defined $got || defined $isnt;
+ }
+ else {
+ $pass = $got ne $isnt;
+ }
+
+ unless( $pass ) {
+ unshift(@mess, "# it should not be "._qq($got)."\n",
+ "# but it is.\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub cmp_ok ($$$@) {
+ my($got, $type, $expected, $name, @mess) = @_;
+
+ my $pass;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $pass = eval "\$got $type \$expected";
+ }
+ unless ($pass) {
+ # It seems Irix long doubles can have 2147483648 and 2147483648
+ # that stringify to the same thing but are actually numerically
+ # different. Display the numbers if $type isn't a string operator,
+ # and the numbers are stringwise the same.
+ # (all string operators have alphabetic names, so tr/a-z// is true)
+ # This will also show numbers for some unneeded cases, but will
+ # definitely be helpful for things such as == and <= that fail
+ if ($got eq $expected and $type !~ tr/a-z//) {
+ unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
+ }
+ unshift(@mess, "# got "._qq($got)."\n",
+ "# expected $type "._qq($expected)."\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+# Check that $got is within $range of $expected
+# if $range is 0, then check it's exact
+# else if $expected is 0, then $range is an absolute value
+# otherwise $range is a fractional error.
+# Here $range must be numeric, >= 0
+# Non numeric ranges might be a useful future extension. (eg %)
+sub within ($$$@) {
+ my ($got, $expected, $range, $name, @mess) = @_;
+ my $pass;
+ if (!defined $got or !defined $expected or !defined $range) {
+ # This is a fail, but doesn't need extra diagnostics
+ } elsif ($got !~ tr/0-9// or $expected !~ tr/0-9// or $range !~ tr/0-9//) {
+ # This is a fail
+ unshift @mess, "# got, expected and range must be numeric\n";
+ } elsif ($range < 0) {
+ # This is also a fail
+ unshift @mess, "# range must not be negative\n";
+ } elsif ($range == 0) {
+ # Within 0 is ==
+ $pass = $got == $expected;
+ } elsif ($expected == 0) {
+ # If expected is 0, treat range as absolute
+ $pass = ($got <= $range) && ($got >= - $range);
+ } else {
+ my $diff = $got - $expected;
+ $pass = abs ($diff / $expected) < $range;
+ }
+ unless ($pass) {
+ if ($got eq $expected) {
+ unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
+ }
+ unshift@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)." (within "._qq($range).")\n";
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub pass {
+ _ok(1, '', @_);
+}
+
+sub fail {
+ _ok(0, _where(), @_);
+}
+
+sub curr_test {
+ $test = shift if @_;
+ return $test;
+}
+
+sub next_test {
+ my $retval = $test;
+ $test = $test + 1; # don't use ++
+ $retval;
+}
+
+# Note: can't pass multipart messages since we try to
+# be compatible with Test::More::skip().
+sub skip {
+ my $why = shift;
+ my $n = @_ ? shift : 1;
+ my $bad_swap;
+ my $both_zero;
+ {
+ local $^W = 0;
+ $bad_swap = $why > 0 && $n == 0;
+ $both_zero = $why == 0 && $n == 0;
+ }
+ if ($bad_swap || $both_zero || @_) {
+ my $arg = "'$why', '$n'";
+ if (@_) {
+ $arg .= join(", ", '', map { qq['$_'] } @_);
+ }
+ die qq[$0: expected skip(why, count), got skip($arg)\n];
+ }
+ for (1..$n) {
+ _print "ok $test # skip $why\n";
+ $test = $test + 1;
+ }
+ local $^W = 0;
+ #last SKIP;
+}
+
+sub eq_array {
+ my ($ra, $rb) = @_;
+ return 0 unless $#$ra == $#$rb;
+ my $i;
+ for $i (0..$#$ra) {
+ next if !defined $ra->[$i] && !defined $rb->[$i];
+ return 0 if !defined $ra->[$i];
+ return 0 if !defined $rb->[$i];
+ return 0 unless $ra->[$i] eq $rb->[$i];
+ }
+ return 1;
+}
+
+sub eq_hash {
+ my ($orig, $suspect) = @_;
+ my $fail;
+ while (my ($key, $value) = each %$suspect) {
+ # Force a hash recompute if this perl's internals can cache the hash key.
+ $key = "" . $key;
+ if (exists $orig->{$key}) {
+ if (
+ defined $orig->{$key} != defined $value
+ || (defined $value && $orig->{$key} ne $value)
+ ) {
+ _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
+ " now ", _qq($value), "\n";
+ $fail = 1;
+ }
+ } else {
+ _print "# key ", _qq($key), " is ", _qq($value),
+ ", not in original.\n";
+ $fail = 1;
+ }
+ }
+ foreach (keys %$orig) {
+ # Force a hash recompute if this perl's internals can cache the hash key.
+ $_ = "" . $_;
+ next if (exists $suspect->{$_});
+ _print "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
+ $fail = 1;
}
+ !$fail;
}
1;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::no_THX_arg("42"), 43);
+is(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
# skip tests on 5.6.0 and earlier, plus 7.0
if ("$]" <= '5.006' || "$]" == '5.007' ) {
- for (1..93) {
- skip 'skip: broken utf8 support', 0;
- }
+ skip 'skip: broken utf8 support', 93;
exit;
}
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
+is(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
-ok(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
+is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6));
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100));
if ("$]" < '5.006') {
- for (1 ..9) {
- ok(1, 1)
- }
+ skip("Perl version too early", 9);
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
- ok(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
- ok(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
+ is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
+ is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
+ is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
if (ord("A") != 65) {
- ok(1, 1)
+ skip("Test not valid on EBCDIC", 1)
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
+ is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
}
}
if ("$]" < '5.008') {
- for (1 ..3) {
- ok(1, 1)
- }
+ skip("Perl version too early", 3);
}
else {
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
}
my $ret = &Devel::PPPort::utf8_to_uvchr("A");
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr("\0");
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
if (ord("A") != 65) { # tests not valid for EBCDIC
- for (1 .. (2 + 4 + (7 * 5))) {
- ok(1, 1);
- }
+ skip("Perl version too early", 1 .. (2 + 4 + (7 * 5)));
}
else {
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
- ok($ret->[0], 0x100);
- ok($ret->[1], 2);
+ is($ret->[0], 0x100);
+ is($ret->[1], 2);
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_; };
{
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0);
- ok($ret->[1], -1);
+ is($ret->[0], 0);
+ is($ret->[1], -1);
BEGIN { 'warnings'->unimport() if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0xFFFD);
- ok($ret->[1], 1);
+ is($ret->[0], 0xFFFD);
+ is($ret->[1], 1);
}
my @buf_tests = (
use vars '%Config';
if ($Config{ccflags} =~ /-DDEBUGGING/) {
shift @buf_tests;
- for (1..5) {
- ok(1, 1);
- }
+ skip("Test not valid on DEBUGGING builds", 5);
}
my $test;
undef @warnings;
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0, "returned value $display; warnings enabled");
- ok($ret->[1], -1, "returned length $display; warnings enabled");
+ is($ret->[0], 0, "returned value $display; warnings enabled");
+ is($ret->[1], -1, "returned length $display; warnings enabled");
my $all_warnings = join "; ", @warnings;
my $contains = grep { $_ =~ $warning } $all_warnings;
- ok($contains, 1, $display
+ is($contains, 1, $display
. "; Got: '$all_warnings', which should contain '$warning'");
undef @warnings;
BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
- ok($ret->[1], $test->{'no_warnings_returned_length'},
+ is($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
+ is($ret->[1], $test->{'no_warnings_returned_length'},
"returned length $display; warnings disabled");
}
}
if ("$]" ge '5.008') {
BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
- ok(Devel::PPPort::sv_len_utf8("aščť"), 4);
- ok(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
my $str = "áíé";
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
tie my $scalar, 'TieScalarCounter', "é";
- ok(tied($scalar)->{fetch}, 0);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 2);
- ok(tied($scalar)->{fetch}, 1);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 3);
- ok(tied($scalar)->{fetch}, 2);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
+ is(tied($scalar)->{fetch}, 0);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 2);
+ is(tied($scalar)->{fetch}, 1);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 3);
+ is(tied($scalar)->{fetch}, 2);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
} else {
- for (1..23) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 23;
}
package TieScalarCounter;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
BEGIN { require warnings if "$]" > '5.006' }
-ok(&Devel::PPPort::sv_setuv(42), 42);
-ok(&Devel::PPPort::newSVuv(123), 123);
-ok(&Devel::PPPort::sv_2uv("4711"), 4711);
-ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
-ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
-ok(&Devel::PPPort::XSRETURN_UV(), 42);
-ok(&Devel::PPPort::PUSHu(), 42);
-ok(&Devel::PPPort::XPUSHu(), 43);
-ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
+is(&Devel::PPPort::sv_setuv(42), 42);
+is(&Devel::PPPort::newSVuv(123), 123);
+is(&Devel::PPPort::sv_2uv("4711"), 4711);
+is(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+is(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+is(&Devel::PPPort::XSRETURN_UV(), 42);
+is(&Devel::PPPort::PUSHu(), 42);
+is(&Devel::PPPort::XPUSHu(), 43);
+is(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(!defined(&Devel::PPPort::PL_sv_undef()));
ok(&Devel::PPPort::PL_sv_yes());
ok(!&Devel::PPPort::PL_sv_no());
-ok(&Devel::PPPort::PL_na("abcd"), 4);
-ok(&Devel::PPPort::PL_Sv(), "mhx");
+is(&Devel::PPPort::PL_na("abcd"), 4);
+is(&Devel::PPPort::PL_Sv(), "mhx");
ok(defined &Devel::PPPort::PL_tokenbuf());
ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
-ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
+is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
for (&Devel::PPPort::other_variables()) {
ok($_ != 0);
else {
ok(@w == 0);
}
- ok($fail, 0);
+ is($fail, 0);
}
ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
eval { &Devel::PPPort::no_dummy_parser_vars(0) };
if ("$]" < 5.009005) {
- ok($@, '');
+ is($@, '');
}
else {
if ($@) {
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$warning = '';
Devel::PPPort::ckWARN();
-ok($warning, '');
+is($warning, '');
$^W = 1;
https://perl5.git.perl.org / perl5.git / commitdiff