1################################################################################
2##
3##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
4##  Version 2.x, Copyright (C) 2001, Paul Marquess.
5##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7##  This program is free software; you can redistribute it and/or
8##  modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14__UNDEFINED__
15END_EXTERN_C
16EXTERN_C
17INT2PTR
18MUTABLE_PTR
19NVTYPE
20PERL_GCC_BRACE_GROUPS_FORBIDDEN
21PERLIO_FUNCS_CAST
22PERLIO_FUNCS_DECL
23PERL_UNUSED_ARG
24PERL_UNUSED_CONTEXT
25PERL_UNUSED_DECL
26PERL_UNUSED_RESULT
27PERL_UNUSED_VAR
28PERL_USE_GCC_BRACE_GROUPS
29PTR2ul
30PTRV
31START_EXTERN_C
32STMT_END
33STMT_START
34SvRX
35UTF8_MAXBYTES
36WIDEST_UTYPE
37XSRETURN
38
39=implementation
40
41__UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
42__UNDEFINED__ OpHAS_SIBLING(o)      (cBOOL((o)->op_sibling))
43__UNDEFINED__ OpSIBLING(o)          (0 + (o)->op_sibling)
44__UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
45__UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
46__UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
47__UNDEFINED__ HEf_SVKEY   -2
48
49#if defined(DEBUGGING) && !defined(__COVERITY__)
50__UNDEFINED__ __ASSERT_(statement)  assert(statement),
51#else
52__UNDEFINED__ __ASSERT_(statement)
53#endif
54
55#ifndef SvRX
56#if { NEED SvRX }
57
58void *
59SvRX(pTHX_ SV *rv)
60{
61	if (SvROK(rv)) {
62		SV *sv = SvRV(rv);
63		if (SvMAGICAL(sv)) {
64			MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
65			if (mg && mg->mg_obj) {
66				return mg->mg_obj;
67			}
68		}
69	}
70	return 0;
71}
72#endif
73#endif
74
75__UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
76
77#ifndef PERL_UNUSED_DECL
78#  ifdef HASATTRIBUTE
79#    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
80#      define PERL_UNUSED_DECL
81#    else
82#      define PERL_UNUSED_DECL __attribute__((unused))
83#    endif
84#  else
85#    define PERL_UNUSED_DECL
86#  endif
87#endif
88
89#ifndef PERL_UNUSED_ARG
90#  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
91#    include <note.h>
92#    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
93#  else
94#    define PERL_UNUSED_ARG(x) ((void)x)
95#  endif
96#endif
97
98#ifndef PERL_UNUSED_VAR
99#  define PERL_UNUSED_VAR(x) ((void)x)
100#endif
101
102#ifndef PERL_UNUSED_CONTEXT
103#  ifdef USE_ITHREADS
104#    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
105#  else
106#    define PERL_UNUSED_CONTEXT
107#  endif
108#endif
109
110#ifndef PERL_UNUSED_RESULT
111#  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
112#    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
113#  else
114#    define PERL_UNUSED_RESULT(v) ((void)(v))
115#  endif
116#endif
117
118__UNDEFINED__  NOOP          /*EMPTY*/(void)0
119__UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
120
121#ifndef NVTYPE
122#  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
123#    define NVTYPE long double
124#  else
125#    define NVTYPE double
126#  endif
127typedef NVTYPE NV;
128#endif
129
130#ifndef INT2PTR
131#  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
132#    define PTRV                  UV
133#    define INT2PTR(any,d)        (any)(d)
134#  else
135#    if PTRSIZE == LONGSIZE
136#      define PTRV                unsigned long
137#    else
138#      define PTRV                unsigned
139#    endif
140#    define INT2PTR(any,d)        (any)(PTRV)(d)
141#  endif
142#endif
143
144#ifndef PTR2ul
145#  if PTRSIZE == LONGSIZE
146#    define PTR2ul(p)     (unsigned long)(p)
147#  else
148#    define PTR2ul(p)     INT2PTR(unsigned long,p)
149#  endif
150#endif
151
152__UNDEFINED__  PTR2nat(p)      (PTRV)(p)
153__UNDEFINED__  NUM2PTR(any,d)  (any)PTR2nat(d)
154__UNDEFINED__  PTR2IV(p)       INT2PTR(IV,p)
155__UNDEFINED__  PTR2UV(p)       INT2PTR(UV,p)
156__UNDEFINED__  PTR2NV(p)       NUM2PTR(NV,p)
157
158#undef START_EXTERN_C
159#undef END_EXTERN_C
160#undef EXTERN_C
161#ifdef __cplusplus
162#  define START_EXTERN_C extern "C" {
163#  define END_EXTERN_C }
164#  define EXTERN_C extern "C"
165#else
166#  define START_EXTERN_C
167#  define END_EXTERN_C
168#  define EXTERN_C extern
169#endif
170
171#if defined(PERL_GCC_PEDANTIC)
172#  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
173#    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
174#  endif
175#endif
176
177#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
178#  ifndef PERL_USE_GCC_BRACE_GROUPS
179#    define PERL_USE_GCC_BRACE_GROUPS
180#  endif
181#endif
182
183#undef STMT_START
184#undef STMT_END
185#ifdef PERL_USE_GCC_BRACE_GROUPS
186#  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
187#  define STMT_END      )
188#else
189#  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
190#    define STMT_START  if (1)
191#    define STMT_END    else (void)0
192#  else
193#    define STMT_START  do
194#    define STMT_END    while (0)
195#  endif
196#endif
197
198__UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
199
200/* DEFSV appears first in 5.004_56 */
201__UNDEFINED__  DEFSV        GvSV(PL_defgv)
202__UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
203__UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
204
205/* Older perls (<=5.003) lack AvFILLp */
206__UNDEFINED__  AvFILLp      AvFILL
207
208__UNDEFINED__  av_tindex    AvFILL
209__UNDEFINED__  av_top_index AvFILL
210
211__UNDEFINED__  ERRSV        get_sv("@",FALSE)
212
213/* Hint: gv_stashpvn
214 * This function's backport doesn't support the length parameter, but
215 * rather ignores it. Portability can only be ensured if the length
216 * parameter is used for speed reasons, but the length can always be
217 * correctly computed from the string argument.
218 */
219
220__UNDEFINED__  gv_stashpvn(str,len,create)  gv_stashpv(str,create)
221
222/* Replace: 1 */
223__UNDEFINED__  get_cv          perl_get_cv
224__UNDEFINED__  get_sv          perl_get_sv
225__UNDEFINED__  get_av          perl_get_av
226__UNDEFINED__  get_hv          perl_get_hv
227/* Replace: 0 */
228
229__UNDEFINED__  dUNDERBAR       dNOOP
230__UNDEFINED__  UNDERBAR        DEFSV
231
232__UNDEFINED__  dAX             I32 ax = MARK - PL_stack_base + 1
233__UNDEFINED__  dITEMS          I32 items = SP - MARK
234
235__UNDEFINED__  dXSTARG         SV * targ = sv_newmortal()
236
237__UNDEFINED__  dAXMARK         I32 ax = POPMARK; \
238                               register SV ** const mark = PL_stack_base + ax++
239
240
241__UNDEFINED__  XSprePUSH       (sp = PL_stack_base + ax - 1)
242
243#if { VERSION < 5.005 }
244#  undef XSRETURN
245#  define XSRETURN(off)                                   \
246      STMT_START {                                        \
247          PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
248          return;                                         \
249      } STMT_END
250#endif
251
252__UNDEFINED__  XSPROTO(name)   void name(pTHX_ CV* cv)
253__UNDEFINED__  SVfARG(p)       ((void*)(p))
254
255__UNDEFINED__  PERL_ABS(x)     ((x) < 0 ? -(x) : (x))
256
257__UNDEFINED__  dVAR            dNOOP
258
259__UNDEFINED__  SVf             "_"
260
261__UNDEFINED__  UTF8_MAXBYTES   UTF8_MAXLEN
262
263__UNDEFINED__  CPERLscope(x)   x
264
265__UNDEFINED__  PERL_HASH(hash,str,len) \
266     STMT_START { \
267        const char *s_PeRlHaSh = str; \
268        I32 i_PeRlHaSh = len; \
269        U32 hash_PeRlHaSh = 0; \
270        while (i_PeRlHaSh--) \
271            hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
272        (hash) = hash_PeRlHaSh; \
273    } STMT_END
274
275#ifndef PERLIO_FUNCS_DECL
276# ifdef PERLIO_FUNCS_CONST
277#  define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
278#  define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
279# else
280#  define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
281#  define PERLIO_FUNCS_CAST(funcs) (funcs)
282# endif
283#endif
284
285/* provide these typedefs for older perls */
286#if { VERSION < 5.9.3 }
287
288# ifdef ARGSproto
289typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
290# else
291typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
292# endif
293
294typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
295
296#endif
297
298#ifndef WIDEST_UTYPE
299# ifdef QUADKIND
300#  ifdef U64TYPE
301#   define WIDEST_UTYPE U64TYPE
302#  else
303#   define WIDEST_UTYPE Quad_t
304#  endif
305# else
306#  define WIDEST_UTYPE U32
307# endif
308#endif
309
310#ifdef EBCDIC
311
312/* This is the first version where these macros are fully correct.  Relying on
313 * the C library functions, as earlier releases did, causes problems with
314 * locales */
315# if { VERSION < 5.22.0 }
316#  undef isALNUM
317#  undef isALNUM_A
318#  undef isALNUMC
319#  undef isALNUMC_A
320#  undef isALPHA
321#  undef isALPHA_A
322#  undef isALPHANUMERIC
323#  undef isALPHANUMERIC_A
324#  undef isASCII
325#  undef isASCII_A
326#  undef isBLANK
327#  undef isBLANK_A
328#  undef isCNTRL
329#  undef isCNTRL_A
330#  undef isDIGIT
331#  undef isDIGIT_A
332#  undef isGRAPH
333#  undef isGRAPH_A
334#  undef isIDCONT
335#  undef isIDCONT_A
336#  undef isIDFIRST
337#  undef isIDFIRST_A
338#  undef isLOWER
339#  undef isLOWER_A
340#  undef isOCTAL
341#  undef isOCTAL_A
342#  undef isPRINT
343#  undef isPRINT_A
344#  undef isPSXSPC
345#  undef isPSXSPC_A
346#  undef isPUNCT
347#  undef isPUNCT_A
348#  undef isSPACE
349#  undef isSPACE_A
350#  undef isUPPER
351#  undef isUPPER_A
352#  undef isWORDCHAR
353#  undef isWORDCHAR_A
354#  undef isXDIGIT
355#  undef isXDIGIT_A
356# endif
357
358__UNDEFINED__ isASCII(c)    (isCNTRL(c) || isPRINT(c))
359
360        /* The below is accurate for all EBCDIC code pages supported by
361         * all the versions of Perl overridden by this */
362__UNDEFINED__ isCNTRL(c)    (    (c) == '\0' || (c) == '\a' || (c) == '\b'      \
363                             ||  (c) == '\f' || (c) == '\n' || (c) == '\r'      \
364                             ||  (c) == '\t' || (c) == '\v'                     \
365                             || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */      \
366                             ||  (c) == 7    /* U+7F DEL */                     \
367                             || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */       \
368                                                      /* DLE, DC[1-3] */        \
369                             ||  (c) == 0x18 /* U+18 CAN */                     \
370                             ||  (c) == 0x19 /* U+19 EOM */                     \
371                             || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */      \
372                             ||  (c) == 0x26 /* U+17 ETB */                     \
373                             ||  (c) == 0x27 /* U+1B ESC */                     \
374                             ||  (c) == 0x2D /* U+05 ENQ */                     \
375                             ||  (c) == 0x2E /* U+06 ACK */                     \
376                             ||  (c) == 0x32 /* U+16 SYN */                     \
377                             ||  (c) == 0x37 /* U+04 EOT */                     \
378                             ||  (c) == 0x3C /* U+14 DC4 */                     \
379                             ||  (c) == 0x3D /* U+15 NAK */                     \
380                             ||  (c) == 0x3F /* U+1A SUB */                     \
381                            )
382/* The ordering of the tests in this and isUPPER are to exclude most characters
383 * early */
384__UNDEFINED__ isLOWER(c)    (        (c) >= 'a' && (c) <= 'z'                   \
385                             &&  (   (c) <= 'i'                                 \
386                                 || ((c) >= 'j' && (c) <= 'r')                  \
387                                 ||  (c) >= 's'))
388__UNDEFINED__ isUPPER(c)    (        (c) >= 'A' && (c) <= 'Z'                   \
389                             && (    (c) <= 'I'                                 \
390                                 || ((c) >= 'J' && (c) <= 'R')                  \
391                                 ||  (c) >= 'S'))
392
393#else   /* Above is EBCDIC; below is ASCII */
394
395# if { VERSION < 5.4.0 }
396/* The implementation of these in older perl versions can give wrong results if
397 * the C program locale is set to other than the C locale */
398#  undef isALNUM
399#  undef isALNUM_A
400#  undef isALPHA
401#  undef isALPHA_A
402#  undef isDIGIT
403#  undef isDIGIT_A
404#  undef isIDFIRST
405#  undef isIDFIRST_A
406#  undef isLOWER
407#  undef isLOWER_A
408#  undef isUPPER
409#  undef isUPPER_A
410# endif
411
412# if { VERSION < 5.8.0 }
413/* Hint: isCNTRL
414 * Earlier perls omitted DEL */
415#  undef isCNTRL
416# endif
417
418# if { VERSION < 5.10.0 }
419/* Hint: isPRINT
420 * The implementation in older perl versions includes all of the
421 * isSPACE() characters, which is wrong. The version provided by
422 * Devel::PPPort always overrides a present buggy version.
423 */
424#  undef isPRINT
425#  undef isPRINT_A
426# endif
427
428# if { VERSION < 5.14.0 }
429/* Hint: isASCII
430 * The implementation in older perl versions always returned true if the
431 * parameter was a signed char
432 */
433#  undef isASCII
434#  undef isASCII_A
435# endif
436
437# if { VERSION < 5.20.0 }
438/* Hint: isSPACE
439 * The implementation in older perl versions didn't include \v */
440#  undef isSPACE
441#  undef isSPACE_A
442# endif
443
444__UNDEFINED__ isASCII(c)        ((WIDEST_UTYPE) (c) <= 127)
445__UNDEFINED__ isCNTRL(c)        ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
446__UNDEFINED__ isLOWER(c)        ((c) >= 'a' && (c) <= 'z')
447__UNDEFINED__ isUPPER(c)        ((c) <= 'Z' && (c) >= 'A')
448#endif /* Below are definitions common to EBCDIC and ASCII */
449
450__UNDEFINED__ isALNUM(c)        isWORDCHAR(c)
451__UNDEFINED__ isALNUMC(c)       isALPHANUMERIC(c)
452__UNDEFINED__ isALPHA(c)        (isUPPER(c) || isLOWER(c))
453__UNDEFINED__ isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
454__UNDEFINED__ isBLANK(c)        ((c) == ' ' || (c) == '\t')
455__UNDEFINED__ isDIGIT(c)        ((c) <= '9' && (c) >= '0')
456__UNDEFINED__ isGRAPH(c)        (isWORDCHAR(c) || isPUNCT(c))
457__UNDEFINED__ isIDCONT(c)       isWORDCHAR(c)
458__UNDEFINED__ isIDFIRST(c)      (isALPHA(c) || (c) == '_')
459__UNDEFINED__ isOCTAL(c)        (((WIDEST_UTYPE)((c)) & ~7) == '0')
460__UNDEFINED__ isPRINT(c)        (isGRAPH(c) || (c) == ' ')
461__UNDEFINED__ isPSXSPC(c)       isSPACE(c)
462__UNDEFINED__ isPUNCT(c)    (   (c) == '-' || (c) == '!' || (c) == '"'          \
463                             || (c) == '#' || (c) == '$' || (c) == '%'          \
464                             || (c) == '&' || (c) == '\'' || (c) == '('         \
465                             || (c) == ')' || (c) == '*' || (c) == '+'          \
466                             || (c) == ',' || (c) == '.' || (c) == '/'          \
467                             || (c) == ':' || (c) == ';' || (c) == '<'          \
468                             || (c) == '=' || (c) == '>' || (c) == '?'          \
469                             || (c) == '@' || (c) == '[' || (c) == '\\'         \
470                             || (c) == ']' || (c) == '^' || (c) == '_'          \
471                             || (c) == '`' || (c) == '{' || (c) == '|'          \
472                             || (c) == '}' || (c) == '~')
473__UNDEFINED__ isSPACE(c)        (   isBLANK(c) || (c) == '\n' || (c) == '\r'    \
474                                 || (c) == '\v' || (c) == '\f')
475__UNDEFINED__ isWORDCHAR(c)     (isALPHANUMERIC(c) || (c) == '_')
476__UNDEFINED__ isXDIGIT(c)       (   isDIGIT(c)                                  \
477                                 || ((c) >= 'a' && (c) <= 'f')                  \
478                                 || ((c) >= 'A' && (c) <= 'F'))
479
480__UNDEFINED__ isALNUM_A         isALNUM
481__UNDEFINED__ isALNUMC_A        isALNUMC
482__UNDEFINED__ isALPHA_A         isALPHA
483__UNDEFINED__ isALPHANUMERIC_A  isALPHANUMERIC
484__UNDEFINED__ isASCII_A         isASCII
485__UNDEFINED__ isBLANK_A         isBLANK
486__UNDEFINED__ isCNTRL_A         isCNTRL
487__UNDEFINED__ isDIGIT_A         isDIGIT
488__UNDEFINED__ isGRAPH_A         isGRAPH
489__UNDEFINED__ isIDCONT_A        isIDCONT
490__UNDEFINED__ isIDFIRST_A       isIDFIRST
491__UNDEFINED__ isLOWER_A         isLOWER
492__UNDEFINED__ isOCTAL_A         isOCTAL
493__UNDEFINED__ isPRINT_A         isPRINT
494__UNDEFINED__ isPSXSPC_A        isPSXSPC
495__UNDEFINED__ isPUNCT_A         isPUNCT
496__UNDEFINED__ isSPACE_A         isSPACE
497__UNDEFINED__ isUPPER_A         isUPPER
498__UNDEFINED__ isWORDCHAR_A	isWORDCHAR
499__UNDEFINED__ isXDIGIT_A	isXDIGIT
500
501/* Until we figure out how to support this in older perls... */
502#if { VERSION >= 5.8.0 }
503
504__UNDEFINED__ HeUTF8(he)        ((HeKLEN(he) == HEf_SVKEY) ?            \
505                                 SvUTF8(HeKEY_sv(he)) :                 \
506                                 (U32)HeKUTF8(he))
507
508#endif
509
510__UNDEFINED__ C_ARRAY_LENGTH(a)		(sizeof(a)/sizeof((a)[0]))
511__UNDEFINED__ C_ARRAY_END(a)		((a) + C_ARRAY_LENGTH(a))
512
513__UNDEFINED__ LIKELY(x) (x)
514__UNDEFINED__ UNLIKELY(x) (x)
515
516__UNDEFINED__ UNICODE_REPLACEMENT  0xFFFD
517
518#ifndef MUTABLE_PTR
519#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
520#  define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
521#else
522#  define MUTABLE_PTR(p) ((void *) (p))
523#endif
524#endif
525
526__UNDEFINED__ MUTABLE_SV(p)   ((SV *)MUTABLE_PTR(p))
527
528=xsmisc
529
530typedef XSPROTO(XSPROTO_test_t);
531typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
532
533XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
534XS(XS_Devel__PPPort_dXSTARG)
535{
536  dXSARGS;
537  dXSTARG;
538  IV iv;
539
540  PERL_UNUSED_VAR(cv);
541  SP -= items;
542  iv = SvIV(ST(0)) + 1;
543  PUSHi(iv);
544  XSRETURN(1);
545}
546
547XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
548XS(XS_Devel__PPPort_dAXMARK)
549{
550  dSP;
551  dAXMARK;
552  dITEMS;
553  IV iv;
554
555  PERL_UNUSED_VAR(cv);
556  SP -= items;
557  iv = SvIV(ST(0)) - 1;
558  mPUSHi(iv);
559  XSRETURN(1);
560}
561
562=xsinit
563
564#define NEED_SvRX
565
566=xsboot
567
568{
569  XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
570  newXS("Devel::PPPort::dXSTARG", *p, file);
571}
572newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
573
574=xsubs
575
576int
577OpSIBLING_tests()
578	PREINIT:
579		OP *x;
580		OP *kid;
581		OP *middlekid;
582		OP *lastkid;
583		int count = 0;
584		int failures = 0;
585		int i;
586	CODE:
587		x = newOP(OP_PUSHMARK, 0);
588
589		/* No siblings yet! */
590		if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
591			failures++; warn("Op should not have had a sib");
592		}
593
594
595		/* Add 2 siblings */
596		kid = x;
597
598		for (i = 0; i < 2; i++) {
599			OP *newsib = newOP(OP_PUSHMARK, 0);
600			OpMORESIB_set(kid, newsib);
601
602			kid = OpSIBLING(kid);
603			lastkid = kid;
604		}
605                middlekid = OpSIBLING(x);
606
607		/* Should now have a sibling */
608		if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
609			failures++; warn("Op should have had a sib after moresib_set");
610		}
611
612		/* Count the siblings */
613		for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) {
614			count++;
615		}
616
617		if (count != 2) {
618			failures++; warn("Kid had %d sibs, expected 2", count);
619		}
620
621		if (OpHAS_SIBLING(lastkid) || OpSIBLING(lastkid)) {
622			failures++; warn("Last kid should not have a sib");
623		}
624
625		/* Really sets the parent, and says 'no more siblings' */
626		OpLASTSIB_set(x, lastkid);
627
628		if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
629			failures++; warn("OpLASTSIB_set failed?");
630		}
631
632		/* Restore the kid */
633		OpMORESIB_set(x, lastkid);
634
635		/* Try to remove it again */
636		OpLASTSIB_set(x, NULL);
637
638		if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
639			failures++; warn("OpLASTSIB_set with NULL failed?");
640		}
641
642		/* Try to restore with maybesib_set */
643		OpMAYBESIB_set(x, lastkid, NULL);
644
645		if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
646			failures++; warn("Op should have had a sib after maybesibset");
647		}
648
649                op_free(lastkid);
650                op_free(middlekid);
651                op_free(x);
652		RETVAL = failures;
653	OUTPUT:
654		RETVAL
655
656int
657SvRXOK(sv)
658	SV *sv
659	CODE:
660		RETVAL = SvRXOK(sv);
661	OUTPUT:
662		RETVAL
663
664int
665ptrtests()
666        PREINIT:
667                int var, *p = &var;
668
669        CODE:
670                RETVAL = 0;
671                RETVAL += PTR2nat(p) != 0       ?  1 : 0;
672                RETVAL += PTR2ul(p) != 0UL      ?  2 : 0;
673                RETVAL += PTR2UV(p) != (UV) 0   ?  4 : 0;
674                RETVAL += PTR2IV(p) != (IV) 0   ?  8 : 0;
675                RETVAL += PTR2NV(p) != (NV) 0   ? 16 : 0;
676                RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0;
677
678        OUTPUT:
679                RETVAL
680
681int
682gv_stashpvn(name, create)
683        char *name
684        I32 create
685        CODE:
686                RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
687        OUTPUT:
688                RETVAL
689
690int
691get_sv(name, create)
692        char *name
693        I32 create
694        CODE:
695                RETVAL = get_sv(name, create) != NULL;
696        OUTPUT:
697                RETVAL
698
699int
700get_av(name, create)
701        char *name
702        I32 create
703        CODE:
704                RETVAL = get_av(name, create) != NULL;
705        OUTPUT:
706                RETVAL
707
708int
709get_hv(name, create)
710        char *name
711        I32 create
712        CODE:
713                RETVAL = get_hv(name, create) != NULL;
714        OUTPUT:
715                RETVAL
716
717int
718get_cv(name, create)
719        char *name
720        I32 create
721        CODE:
722                RETVAL = get_cv(name, create) != NULL;
723        OUTPUT:
724                RETVAL
725
726void
727xsreturn(two)
728        int two
729        PPCODE:
730                mXPUSHp("test1", 5);
731                if (two)
732                  mXPUSHp("test2", 5);
733                if (two)
734                  XSRETURN(2);
735                else
736                  XSRETURN(1);
737
738SV*
739boolSV(value)
740        int value
741        CODE:
742                RETVAL = newSVsv(boolSV(value));
743        OUTPUT:
744                RETVAL
745
746SV*
747DEFSV()
748        CODE:
749                RETVAL = newSVsv(DEFSV);
750        OUTPUT:
751                RETVAL
752
753void
754DEFSV_modify()
755        PPCODE:
756                XPUSHs(sv_mortalcopy(DEFSV));
757                ENTER;
758                SAVE_DEFSV;
759                DEFSV_set(newSVpvs("DEFSV"));
760                XPUSHs(sv_mortalcopy(DEFSV));
761                /* Yes, this leaks the above scalar; 5.005 with threads for some reason */
762                /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
763                /* sv_2mortal(DEFSV); */
764                LEAVE;
765                XPUSHs(sv_mortalcopy(DEFSV));
766                XSRETURN(3);
767
768int
769ERRSV()
770        CODE:
771                RETVAL = SvTRUE(ERRSV);
772        OUTPUT:
773                RETVAL
774
775SV*
776UNDERBAR()
777        CODE:
778                {
779                  dUNDERBAR;
780                  RETVAL = newSVsv(UNDERBAR);
781                }
782        OUTPUT:
783                RETVAL
784
785void
786prepush()
787        CODE:
788                {
789                  dXSTARG;
790                  XSprePUSH;
791                  PUSHi(42);
792                  XSRETURN(1);
793                }
794
795int
796PERL_ABS(a)
797        int a
798
799void
800SVf(x)
801        SV *x
802        PPCODE:
803#if { VERSION >= 5.004 }
804                x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
805#endif
806                XPUSHs(x);
807                XSRETURN(1);
808
809void
810Perl_ppaddr_t(string)
811        char *string
812        PREINIT:
813                Perl_ppaddr_t lower;
814        PPCODE:
815                lower = PL_ppaddr[OP_LC];
816                mXPUSHs(newSVpv(string, 0));
817                PUTBACK;
818                ENTER;
819                (void)*(lower)(aTHXR);
820                SPAGAIN;
821                LEAVE;
822                XSRETURN(1);
823
824#if { VERSION >= 5.8.0 }
825
826void
827check_HeUTF8(utf8_key)
828        SV *utf8_key;
829        PREINIT:
830                HV *hash;
831                HE *ent;
832                STRLEN klen;
833                char *key;
834        PPCODE:
835                hash = newHV();
836
837                key = SvPV(utf8_key, klen);
838                if (SvUTF8(utf8_key)) klen *= -1;
839                hv_store(hash, key, klen, newSVpvs("string"), 0);
840                hv_iterinit(hash);
841                ent = hv_iternext(hash);
842                assert(ent);
843                mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
844                hv_undef(hash);
845
846
847#endif
848
849void
850check_c_array()
851        PREINIT:
852                int x[] = { 10, 11, 12, 13 };
853        PPCODE:
854                mXPUSHi(C_ARRAY_LENGTH(x));  /* 4 */
855                mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
856
857bool
858test_isBLANK(UV ord)
859    CODE:
860        RETVAL = isBLANK(ord);
861    OUTPUT:
862        RETVAL
863
864bool
865test_isBLANK_A(UV ord)
866    CODE:
867        RETVAL = isBLANK_A(ord);
868    OUTPUT:
869        RETVAL
870
871bool
872test_isUPPER(UV ord)
873    CODE:
874        RETVAL = isUPPER(ord);
875    OUTPUT:
876        RETVAL
877
878bool
879test_isUPPER_A(UV ord)
880    CODE:
881        RETVAL = isUPPER_A(ord);
882    OUTPUT:
883        RETVAL
884
885bool
886test_isLOWER(UV ord)
887    CODE:
888        RETVAL = isLOWER(ord);
889    OUTPUT:
890        RETVAL
891
892bool
893test_isLOWER_A(UV ord)
894    CODE:
895        RETVAL = isLOWER_A(ord);
896    OUTPUT:
897        RETVAL
898
899bool
900test_isALPHA(UV ord)
901    CODE:
902        RETVAL = isALPHA(ord);
903    OUTPUT:
904        RETVAL
905
906bool
907test_isALPHA_A(UV ord)
908    CODE:
909        RETVAL = isALPHA_A(ord);
910    OUTPUT:
911        RETVAL
912
913bool
914test_isWORDCHAR(UV ord)
915    CODE:
916        RETVAL = isWORDCHAR(ord);
917    OUTPUT:
918        RETVAL
919
920bool
921test_isWORDCHAR_A(UV ord)
922    CODE:
923        RETVAL = isWORDCHAR_A(ord);
924    OUTPUT:
925        RETVAL
926
927bool
928test_isALPHANUMERIC(UV ord)
929    CODE:
930        RETVAL = isALPHANUMERIC(ord);
931    OUTPUT:
932        RETVAL
933
934bool
935test_isALPHANUMERIC_A(UV ord)
936    CODE:
937        RETVAL = isALPHANUMERIC_A(ord);
938    OUTPUT:
939        RETVAL
940
941bool
942test_isALNUM(UV ord)
943    CODE:
944        RETVAL = isALNUM(ord);
945    OUTPUT:
946        RETVAL
947
948bool
949test_isALNUM_A(UV ord)
950    CODE:
951        RETVAL = isALNUM_A(ord);
952    OUTPUT:
953        RETVAL
954
955bool
956test_isDIGIT(UV ord)
957    CODE:
958        RETVAL = isDIGIT(ord);
959    OUTPUT:
960        RETVAL
961
962bool
963test_isDIGIT_A(UV ord)
964    CODE:
965        RETVAL = isDIGIT_A(ord);
966    OUTPUT:
967        RETVAL
968
969bool
970test_isOCTAL(UV ord)
971    CODE:
972        RETVAL = isOCTAL(ord);
973    OUTPUT:
974        RETVAL
975
976bool
977test_isOCTAL_A(UV ord)
978    CODE:
979        RETVAL = isOCTAL_A(ord);
980    OUTPUT:
981        RETVAL
982
983bool
984test_isIDFIRST(UV ord)
985    CODE:
986        RETVAL = isIDFIRST(ord);
987    OUTPUT:
988        RETVAL
989
990bool
991test_isIDFIRST_A(UV ord)
992    CODE:
993        RETVAL = isIDFIRST_A(ord);
994    OUTPUT:
995        RETVAL
996
997bool
998test_isIDCONT(UV ord)
999    CODE:
1000        RETVAL = isIDCONT(ord);
1001    OUTPUT:
1002        RETVAL
1003
1004bool
1005test_isIDCONT_A(UV ord)
1006    CODE:
1007        RETVAL = isIDCONT_A(ord);
1008    OUTPUT:
1009        RETVAL
1010
1011bool
1012test_isSPACE(UV ord)
1013    CODE:
1014        RETVAL = isSPACE(ord);
1015    OUTPUT:
1016        RETVAL
1017
1018bool
1019test_isSPACE_A(UV ord)
1020    CODE:
1021        RETVAL = isSPACE_A(ord);
1022    OUTPUT:
1023        RETVAL
1024
1025bool
1026test_isASCII(UV ord)
1027    CODE:
1028        RETVAL = isASCII(ord);
1029    OUTPUT:
1030        RETVAL
1031
1032bool
1033test_isASCII_A(UV ord)
1034    CODE:
1035        RETVAL = isASCII_A(ord);
1036    OUTPUT:
1037        RETVAL
1038
1039bool
1040test_isCNTRL(UV ord)
1041    CODE:
1042        RETVAL = isCNTRL(ord);
1043    OUTPUT:
1044        RETVAL
1045
1046bool
1047test_isCNTRL_A(UV ord)
1048    CODE:
1049        RETVAL = isCNTRL_A(ord);
1050    OUTPUT:
1051        RETVAL
1052
1053bool
1054test_isPRINT(UV ord)
1055    CODE:
1056        RETVAL = isPRINT(ord);
1057    OUTPUT:
1058        RETVAL
1059
1060bool
1061test_isPRINT_A(UV ord)
1062    CODE:
1063        RETVAL = isPRINT_A(ord);
1064    OUTPUT:
1065        RETVAL
1066
1067bool
1068test_isGRAPH(UV ord)
1069    CODE:
1070        RETVAL = isGRAPH(ord);
1071    OUTPUT:
1072        RETVAL
1073
1074bool
1075test_isGRAPH_A(UV ord)
1076    CODE:
1077        RETVAL = isGRAPH_A(ord);
1078    OUTPUT:
1079        RETVAL
1080
1081bool
1082test_isPUNCT(UV ord)
1083    CODE:
1084        RETVAL = isPUNCT(ord);
1085    OUTPUT:
1086        RETVAL
1087
1088bool
1089test_isPUNCT_A(UV ord)
1090    CODE:
1091        RETVAL = isPUNCT_A(ord);
1092    OUTPUT:
1093        RETVAL
1094
1095bool
1096test_isXDIGIT(UV ord)
1097    CODE:
1098        RETVAL = isXDIGIT(ord);
1099    OUTPUT:
1100        RETVAL
1101
1102bool
1103test_isXDIGIT_A(UV ord)
1104    CODE:
1105        RETVAL = isXDIGIT_A(ord);
1106    OUTPUT:
1107        RETVAL
1108
1109bool
1110test_isPSXSPC(UV ord)
1111    CODE:
1112        RETVAL = isPSXSPC(ord);
1113    OUTPUT:
1114        RETVAL
1115
1116bool
1117test_isPSXSPC_A(UV ord)
1118    CODE:
1119        RETVAL = isPSXSPC_A(ord);
1120    OUTPUT:
1121        RETVAL
1122
1123STRLEN
1124av_tindex(av)
1125        AV *av
1126        CODE:
1127                RETVAL = av_tindex(av);
1128        OUTPUT:
1129                RETVAL
1130
1131STRLEN
1132av_top_index(av)
1133        AV *av
1134        CODE:
1135                RETVAL = av_top_index(av);
1136        OUTPUT:
1137                RETVAL
1138
1139=tests plan => 128
1140
1141use vars qw($my_sv @my_av %my_hv);
1142
1143ok(&Devel::PPPort::boolSV(1));
1144ok(!&Devel::PPPort::boolSV(0));
1145
1146$_ = "Fred";
1147ok(&Devel::PPPort::DEFSV(), "Fred");
1148ok(&Devel::PPPort::UNDERBAR(), "Fred");
1149
1150if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
1151  eval q{
1152    no warnings "deprecated";
1153    no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
1154    my $_ = "Tony";
1155    ok(&Devel::PPPort::DEFSV(), "Fred");
1156    ok(&Devel::PPPort::UNDERBAR(), "Tony");
1157  };
1158}
1159else {
1160  ok(1);
1161  ok(1);
1162}
1163
1164my @r = &Devel::PPPort::DEFSV_modify();
1165
1166ok(@r == 3);
1167ok($r[0], 'Fred');
1168ok($r[1], 'DEFSV');
1169ok($r[2], 'Fred');
1170
1171ok(&Devel::PPPort::DEFSV(), "Fred");
1172
1173eval { 1 };
1174ok(!&Devel::PPPort::ERRSV());
1175eval { cannot_call_this_one() };
1176ok(&Devel::PPPort::ERRSV());
1177
1178ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
1179ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
1180ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
1181
1182$my_sv = 1;
1183ok(&Devel::PPPort::get_sv('my_sv', 0));
1184ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
1185ok(&Devel::PPPort::get_sv('not_my_sv', 1));
1186
1187@my_av = (1);
1188ok(&Devel::PPPort::get_av('my_av', 0));
1189ok(!&Devel::PPPort::get_av('not_my_av', 0));
1190ok(&Devel::PPPort::get_av('not_my_av', 1));
1191
1192%my_hv = (a=>1);
1193ok(&Devel::PPPort::get_hv('my_hv', 0));
1194ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
1195ok(&Devel::PPPort::get_hv('not_my_hv', 1));
1196
1197sub my_cv { 1 };
1198ok(&Devel::PPPort::get_cv('my_cv', 0));
1199ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
1200ok(&Devel::PPPort::get_cv('not_my_cv', 1));
1201
1202ok(Devel::PPPort::dXSTARG(42), 43);
1203ok(Devel::PPPort::dAXMARK(4711), 4710);
1204
1205ok(Devel::PPPort::prepush(), 42);
1206
1207ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
1208ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
1209
1210ok(Devel::PPPort::PERL_ABS(42), 42);
1211ok(Devel::PPPort::PERL_ABS(-13), 13);
1212
1213ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
1214ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
1215
1216ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
1217
1218ok(&Devel::PPPort::ptrtests(), 63);
1219
1220ok(&Devel::PPPort::OpSIBLING_tests(), 0);
1221
1222if ("$]" >= 5.009000) {
1223  eval q{
1224    ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
1225    ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
1226  };
1227} else {
1228  ok(1, 1);
1229  ok(1, 1);
1230}
1231
1232@r = &Devel::PPPort::check_c_array();
1233ok($r[0], 4);
1234ok($r[1], "13");
1235
1236ok(!Devel::PPPort::SvRXOK(""));
1237ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
1238
1239if ("$]" < 5.005) {
1240        skip 'no qr// objects in this perl', 0;
1241        skip 'no qr// objects in this perl', 0;
1242} else {
1243        my $qr = eval 'qr/./';
1244        ok(Devel::PPPort::SvRXOK($qr));
1245        ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise"));
1246}
1247
1248ok(  Devel::PPPort::test_isBLANK(ord(" ")));
1249ok(! Devel::PPPort::test_isBLANK(ord("\n")));
1250
1251ok(  Devel::PPPort::test_isBLANK_A(ord("\t")));
1252ok(! Devel::PPPort::test_isBLANK_A(ord("\r")));
1253
1254ok(  Devel::PPPort::test_isUPPER(ord("A")));
1255ok(! Devel::PPPort::test_isUPPER(ord("a")));
1256
1257ok(  Devel::PPPort::test_isUPPER_A(ord("Z")));
1258
1259# One of these two is uppercase in EBCDIC; the other in Latin1, but neither are
1260# ASCII uppercase.
1261ok(! Devel::PPPort::test_isUPPER_A(ord(0xDC)));
1262ok(! Devel::PPPort::test_isUPPER_A(ord(0xFC)));
1263
1264ok(  Devel::PPPort::test_isLOWER(ord("b")));
1265ok(! Devel::PPPort::test_isLOWER(ord("B")));
1266
1267ok(  Devel::PPPort::test_isLOWER_A(ord("y")));
1268
1269# One of these two is lowercase in EBCDIC; the other in Latin1, but neither are
1270# ASCII lowercase.
1271ok(! Devel::PPPort::test_isLOWER_A(ord(0xDC)));
1272ok(! Devel::PPPort::test_isLOWER_A(ord(0xFC)));
1273
1274ok(  Devel::PPPort::test_isALPHA(ord("C")));
1275ok(! Devel::PPPort::test_isALPHA(ord("1")));
1276
1277ok(  Devel::PPPort::test_isALPHA_A(ord("x")));
1278ok(! Devel::PPPort::test_isALPHA_A(0xDC));
1279
1280ok(  Devel::PPPort::test_isWORDCHAR(ord("_")));
1281ok(! Devel::PPPort::test_isWORDCHAR(ord("@")));
1282
1283ok(  Devel::PPPort::test_isWORDCHAR_A(ord("2")));
1284ok(! Devel::PPPort::test_isWORDCHAR_A(0xFC));
1285
1286ok(  Devel::PPPort::test_isALPHANUMERIC(ord("4")));
1287ok(! Devel::PPPort::test_isALPHANUMERIC(ord("_")));
1288
1289ok(  Devel::PPPort::test_isALPHANUMERIC_A(ord("l")));
1290ok(! Devel::PPPort::test_isALPHANUMERIC_A(0xDC));
1291
1292ok(  Devel::PPPort::test_isALNUM(ord("c")));
1293ok(! Devel::PPPort::test_isALNUM(ord("}")));
1294
1295ok(  Devel::PPPort::test_isALNUM_A(ord("5")));
1296ok(! Devel::PPPort::test_isALNUM_A(0xFC));
1297
1298ok(  Devel::PPPort::test_isDIGIT(ord("6")));
1299ok(! Devel::PPPort::test_isDIGIT(ord("_")));
1300
1301ok(  Devel::PPPort::test_isDIGIT_A(ord("7")));
1302ok(! Devel::PPPort::test_isDIGIT_A(0xDC));
1303
1304ok(  Devel::PPPort::test_isOCTAL(ord("7")));
1305ok(! Devel::PPPort::test_isOCTAL(ord("8")));
1306
1307ok(  Devel::PPPort::test_isOCTAL_A(ord("0")));
1308ok(! Devel::PPPort::test_isOCTAL_A(ord("9")));
1309
1310ok(  Devel::PPPort::test_isIDFIRST(ord("D")));
1311ok(! Devel::PPPort::test_isIDFIRST(ord("1")));
1312
1313ok(  Devel::PPPort::test_isIDFIRST_A(ord("_")));
1314ok(! Devel::PPPort::test_isIDFIRST_A(0xFC));
1315
1316ok(  Devel::PPPort::test_isIDCONT(ord("e")));
1317ok(! Devel::PPPort::test_isIDCONT(ord("@")));
1318
1319ok(  Devel::PPPort::test_isIDCONT_A(ord("2")));
1320ok(! Devel::PPPort::test_isIDCONT_A(0xDC));
1321
1322ok(  Devel::PPPort::test_isSPACE(ord(" ")));
1323ok(! Devel::PPPort::test_isSPACE(ord("_")));
1324
1325ok(  Devel::PPPort::test_isSPACE_A(ord("\cK")));
1326ok(! Devel::PPPort::test_isSPACE_A(ord("F")));
1327
1328# This stresses the edge for ASCII machines, but happens to work on EBCDIC as
1329# well
1330ok(  Devel::PPPort::test_isASCII(0x7F));
1331ok(! Devel::PPPort::test_isASCII(0x80));
1332
1333ok(  Devel::PPPort::test_isASCII_A(ord("9")));
1334
1335# B6 is the PARAGRAPH SIGN in ASCII and EBCDIC
1336ok(! Devel::PPPort::test_isASCII_A(0xB6));
1337
1338ok(  Devel::PPPort::test_isCNTRL(ord("\e")));
1339ok(! Devel::PPPort::test_isCNTRL(ord(" ")));
1340
1341ok(  Devel::PPPort::test_isCNTRL_A(ord("\a")));
1342ok(! Devel::PPPort::test_isCNTRL_A(0xB6));
1343
1344ok(  Devel::PPPort::test_isPRINT(ord(" ")));
1345ok(! Devel::PPPort::test_isPRINT(ord("\n")));
1346
1347ok(  Devel::PPPort::test_isPRINT_A(ord("G")));
1348ok(! Devel::PPPort::test_isPRINT_A(0xB6));
1349
1350ok(  Devel::PPPort::test_isGRAPH(ord("h")));
1351ok(! Devel::PPPort::test_isGRAPH(ord(" ")));
1352
1353ok(  Devel::PPPort::test_isGRAPH_A(ord("i")));
1354ok(! Devel::PPPort::test_isGRAPH_A(0xB6));
1355
1356ok(  Devel::PPPort::test_isPUNCT(ord("#")));
1357ok(! Devel::PPPort::test_isPUNCT(ord(" ")));
1358
1359ok(  Devel::PPPort::test_isPUNCT_A(ord("*")));
1360ok(! Devel::PPPort::test_isPUNCT_A(0xB6));
1361
1362ok(  Devel::PPPort::test_isXDIGIT(ord("A")));
1363ok(! Devel::PPPort::test_isXDIGIT(ord("_")));
1364
1365ok(  Devel::PPPort::test_isXDIGIT_A(ord("9")));
1366ok(! Devel::PPPort::test_isXDIGIT_A(0xDC));
1367
1368ok(  Devel::PPPort::test_isPSXSPC(ord(" ")));
1369ok(! Devel::PPPort::test_isPSXSPC(ord("k")));
1370
1371ok(  Devel::PPPort::test_isPSXSPC_A(ord("\cK")));
1372ok(! Devel::PPPort::test_isPSXSPC_A(0xFC));
1373
1374ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
1375ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
1376