Репозиторий Sisyphus
Последнее обновление: 1 октября 2023 | Пакетов: 18631 | Посещений: 37814867
en ru br
Репозитории ALT

Группа :: Разработка/Perl
Пакет: perl-B-Flags

 Главная   Изменения   Спек   Патчи   Исходники   Загрузить   Gear   Bugs and FR  Repocop 

pax_global_header00006660000000000000000000000064122121525110014502gustar00rootroot0000000000000052 comment=c1c72560b47de228cb412496e545bf8778cce2ca
perl-B-Flags-0.10/000075500000000000000000000000001221215251100135735ustar00rootroot00000000000000perl-B-Flags-0.10/Changes000064400000000000000000000030611221215251100150660ustar00rootroot00000000000000Revision history for Perl extension B::Flags.

0.10  2013-09-05 10:56:58 rurban
        - align with core dump.c
        - rename COW to IsCOW
	- fix wrong PCS_IMPORTED flag
        - dont print THINKFIRST on IsCOW

0.09  2013-09-03 10:12:08 rurban@cpan.org
	- protect SvTAIL from SvSCREAM variables
        - enable PVMG vars default flags: EVALED,IsUV,UTF8

0.08  2013-08-28 16:50:50 rurban@cpan.org
	- fix wrong PCS_IMPORTED flag
        - added gpg signature

0.07  2013-08-28 11:40:39 rurban@cpan.org
	- add to B::SV::flagspv: COW, THINKFIRST, PADNAME, PADNAMELIST,
	  TYPED, OUR, STATE
        - add bits to B::OP::flagspv: OPT, LATEFREE, LATEFREED, ATTACHED,
	  SLABBED, SAVEFREE, STATIC, FOLDED

0.06  2012-03-06 rurban@cpan.org
	- fix heap-buffer-overflow detected by address-sanitizer
	  with empty sv->flagspv

0.05  2011-12-15 rurban@cpan.org
	- fix for apple clang 1.7 (LLVM 2.9svn), works okay with clang 3.1

0.04  2010-09-11 rurban@cpan.org
	- add doc for the methods
        - new optional type argument for SV->flagspv
          to seperate between sv->FLAGS and special
          AvFLAGS, GvFLAGS, CvFLAGS, ...
          type 0 is for SvFLAGS only.
        - fix OP_IS_FILETEST_ACCESS arg
        - convert tests to Test::More

0.03  Thu Jul 29 19:33:20 2010 rurban@cpan.org
	- updates for 5.14
	- several new svflags
	- set PROTOTYPE: DISABLE

0.02  2008-03-02 22:11:08 rurban@cpan.org
	- updates for 5.10 and 5.11@33408
	- prefixed op want flags with "WANT_"

0.01  Sun May 13 19:35:25 2001
	- original version; created by h2xs 1.20 with options
		-A -n B::Flags

perl-B-Flags-0.10/Flags.pm000064400000000000000000000032271221215251100151710ustar00rootroot00000000000000package B::Flags;

use B;

require 5.005_62;
use strict;
use warnings;

require DynaLoader;
our @ISA = qw(DynaLoader);

our $VERSION = '0.10';

bootstrap B::Flags $VERSION;

# Preloaded methods go here.

1;
__END__

=head1 NAME

B::Flags - Friendlier flags for B

=head1 SYNOPSIS

  use B::Flags;
  print B::main_root->flagspv;
  print B::main_root->privatepv;
  print $some_b_sv_object->flagspv;

=head1 DESCRIPTION

By default, C<$foo-E<gt>flags> when passed an object in the C<B> class
will produce a relatively meaningless number, which one would need to
grovel through the Perl source code in order to do anything useful with.
This module adds C<flagspv> to the SV and op classes and C<privatepv> to
the op classes, which makes them easier to understand.

B<Warning>: This module is not I<guaranteed> compatible with any version
of Perl below 5.7.0; however, I'd like to make it so compatible, so if
it fails to compile, mail me. There's probably an C<#ifdef> I need to
add somewhere...

=head1 METHODS

=over

=item OP->flagspv

Returns stringification of the OP flags.

=item OP->privatepv

Returns stringification of the OP private flags.

=item SV->flagspv [type]

Returns stringification of the SV flags.

With the optional type only the flags for the given SvTYPE are used.
type 0 is for the SvFLAGS only.
This way you can seperate between sv->FLAGS and specialized AvFLAGS,
GvFLAGS, CvFLAGS, ... in seperate struct fields.

=back

=head1 AUTHOR

Simon Cozens, simon@cpan.org

=head1 MAINTAINER

Abhijit Menon-Sen, ams@cpan.org

Reini Urban, rurban@cpan.org

=head1 SEE ALSO

perl(1).

=head1 LICENSE

AL&GPL.
Copyright 2001 Simon Cozens
Copyright 2010,2013 Reini Urban

=cut
perl-B-Flags-0.10/Flags.xs000064400000000000000000000463301221215251100152110ustar00rootroot00000000000000/* -*- mode:c tabwidth:4 -*- */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define OPT_BITS

typedef OP  *B__OP;
typedef SV  *B__SV;

MODULE = B::Flags		PACKAGE = B::OP		
PROTOTYPES: DISABLE

SV*
flagspv(o)
    B::OP   o
    CODE:
        RETVAL = newSVpvn("", 0);
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
            sv_catpv(RETVAL, ",WANT_VOID");
            break;
        case OPf_WANT_SCALAR:
            sv_catpv(RETVAL, ",WANT_SCALAR");
            break;
        case OPf_WANT_LIST:
            sv_catpv(RETVAL, ",WANT_LIST");
            break;
        default:
            sv_catpv(RETVAL, ",WANT_UNKNOWN");
            break;
        }
        if (o->op_flags & OPf_KIDS)
            sv_catpv(RETVAL, ",KIDS");
        if (o->op_flags & OPf_PARENS)
            sv_catpv(RETVAL, ",PARENS");
        if (o->op_flags & OPf_STACKED)
            sv_catpv(RETVAL, ",STACKED");
        if (o->op_flags & OPf_REF)
            sv_catpv(RETVAL, ",REF");
        if (o->op_flags & OPf_MOD)
            sv_catpv(RETVAL, ",MOD");
        if (o->op_flags & OPf_SPECIAL)
            sv_catpv(RETVAL, ",SPECIAL");
#ifdef OPT_BITS
#if PERL_VERSION >= 10
        if (o->op_opt)
            sv_catpv(RETVAL, ",OPT");
#if (PERL_VERSION == 17 && PERL_SUBVERSION < 3) || PERL_VERSION < 17
        if (o->op_latefree)
            sv_catpv(RETVAL, ",LATEFREE");
        if (o->op_latefreed)
            sv_catpv(RETVAL, ",LATEFREED");
        if (o->op_attached)
            sv_catpv(RETVAL, ",ATTACHED");
#endif
#if (PERL_VERSION == 17 && PERL_SUBVERSION >= 2) || PERL_VERSION >= 18
        if (o->op_slabbed)
            sv_catpv(RETVAL, ",SLABBED");
        if (o->op_savefree)
            sv_catpv(RETVAL, ",SAVEFREE");
#if (PERL_VERSION == 17 && PERL_SUBVERSION >= 6) || PERL_VERSION >= 18
        if (o->op_static)
            sv_catpv(RETVAL, ",STATIC");
#if (PERL_VERSION == 19 && PERL_SUBVERSION > 2) || PERL_VERSION >= 20
        if (o->op_folded)
            sv_catpv(RETVAL, ",FOLDED");
#endif
#endif
#endif
#endif
#endif
        if (SvCUR(RETVAL))
            sv_chop(RETVAL, SvPVX(RETVAL)+1); /* Ow. */
    OUTPUT:
        RETVAL

SV*
privatepv(o)
    B::OP   o
    CODE:
        RETVAL = newSVpvn("", 0);
        /* This needs past-proofing. :) */
        if (PL_opargs[o->op_type] & OA_TARGLEX) {
#ifdef OPpTARGET_MY
            if (o->op_private & OPpTARGET_MY)
                sv_catpv(RETVAL, ",TARGET_MY");
#endif
        }
        if (o->op_type == OP_ENTERITER || o->op_type == OP_ITER) {
#ifdef OPpITER_REVERSED
            if (o->op_private & OPpITER_REVERSED)
                sv_catpv(RETVAL, ",ITER_REVERSED");
#endif
#ifdef OPpITER_DEF
            if (o->op_private & OPpITER_DEF)
                sv_catpv(RETVAL, ",ITER_DEF");
#endif
        }
#ifdef OPpREFCOUNTED
        else if (o->op_type == OP_LEAVESUB ||
                 o->op_type == OP_LEAVE ||
                 o->op_type == OP_LEAVESUBLV ||
                 o->op_type == OP_LEAVEWRITE) {
            if (o->op_private & OPpREFCOUNTED)
                sv_catpv(RETVAL, ",REFCOUNTED");
        }
#endif
        else if (o->op_type == OP_AASSIGN) {
#ifdef  OPpASSIGN_COMMON
            if (o->op_private & OPpASSIGN_COMMON)
                sv_catpv(RETVAL, ",COMMON");
#endif
#ifdef  OPpASSIGN_HASH
            if (o->op_private & OPpASSIGN_HASH)
                sv_catpv(RETVAL, ",HASH");
#endif
        }
#ifdef  OPpASSIGN_BACKWARDS
        else if (o->op_type == OP_SASSIGN) {
            if (o->op_private & OPpASSIGN_BACKWARDS)
                sv_catpv(RETVAL, ",BACKWARDS");
        }
#endif
#ifdef OPpRUNTIME
        else if (o->op_type == OP_MATCH ||
                 o->op_type == OP_SUBST) {
            if (o->op_private & OPpRUNTIME)
                sv_catpv(RETVAL, ",RUNTIME");
        }
#endif
        else if (o->op_type == OP_TRANS) {
#ifdef OPpTRANS_FROM_UTF
            if (o->op_private & OPpTRANS_FROM_UTF)
                sv_catpv(RETVAL, ",FROM_UTF");
#endif
#ifdef OPpTRANS_TO_UTF
            if (o->op_private & OPpTRANS_TO_UTF)
                sv_catpv(RETVAL, ",TO_UTF");
#endif
#ifdef OPpTRANS_SQUASH
            if (o->op_private & OPpTRANS_SQUASH)
                sv_catpv(RETVAL, ",SQUASH");
#endif
#ifdef OPpTRANS_DELETE
            if (o->op_private & OPpTRANS_DELETE)
                sv_catpv(RETVAL, ",DELETE");
#endif
#ifdef OPpTRANS_COMPLEMENT
            if (o->op_private & OPpTRANS_COMPLEMENT)
                sv_catpv(RETVAL, ",COMPLEMENT");
#endif
#ifdef OPpTRANS_IDENTICAL
            if (o->op_private & OPpTRANS_IDENTICAL)
                sv_catpv(RETVAL, ",IDENTICAL");
#endif
#ifdef OPpTRANS_GROWS
            if (o->op_private & OPpTRANS_GROWS)
                sv_catpv(RETVAL, ",GROWS");
#endif
        }
#ifdef OPpREPEAT_DOLIST
        else if (o->op_type == OP_REPEAT) {
            if (o->op_private & OPpREPEAT_DOLIST)
                sv_catpv(RETVAL, ",DOLIST");
#endif
        }
        else if (o->op_type == OP_ENTERSUB ||
                 o->op_type == OP_RV2SV ||
                 o->op_type == OP_GVSV ||
                 o->op_type == OP_RV2AV ||
                 o->op_type == OP_RV2HV ||
                 o->op_type == OP_RV2GV ||
                 o->op_type == OP_AELEM ||
                 o->op_type == OP_HELEM )
        {
            if (o->op_type == OP_ENTERSUB) {
#ifdef OPpENTERSUB_AMPER
                if (o->op_private & OPpENTERSUB_AMPER)
                    sv_catpv(RETVAL, ",AMPER");
#endif
#ifdef OPpENTERSUB_DB
                if (o->op_private & OPpENTERSUB_DB)
                    sv_catpv(RETVAL, ",DB");
#endif
#ifdef OPpENTERSUB_HASTARG
                if (o->op_private & OPpENTERSUB_HASTARG)
                    sv_catpv(RETVAL, ",HASTARG");
#endif
#ifdef OPpENTERSUB_NOPAREN
                if (o->op_private & OPpENTERSUB_NOPAREN)
                    sv_catpv(RETVAL, ",NOPAREN");
#endif
#ifdef OPpENTERSUB_INARGS
                if (o->op_private & OPpENTERSUB_INARGS)
                    sv_catpv(RETVAL, ",INARGS");
#endif
            }
            else {
#ifdef OPpDEREF
                switch (o->op_private & OPpDEREF) {
            case OPpDEREF_SV:
                sv_catpv(RETVAL, ",SV");
                break;
            case OPpDEREF_AV:
                sv_catpv(RETVAL, ",AV");
                break;
            case OPpDEREF_HV:
                sv_catpv(RETVAL, ",HV");
                break;
            }
#endif
#ifdef OPpMAYBE_LVSUB
                if (o->op_private & OPpMAYBE_LVSUB)
                    sv_catpv(RETVAL, ",MAYBE_LVSUB");
#endif
            }
            if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
#ifdef OPpLVAL_DEFER
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(RETVAL, ",LVAL_DEFER");
#endif
            }
            else {
                if (o->op_private & HINT_STRICT_REFS)
                    sv_catpv(RETVAL, ",STRICT_REFS");
#ifdef OPpOUR_INTRO
                if (o->op_private & OPpOUR_INTRO)
                    sv_catpv(RETVAL, ",OUR_INTRO");
#endif
            }
        }
#ifdef OPpPAD_STATE
        else if ((o->op_type == OP_PADSV) && (o->op_private & OPpPAD_STATE))
		sv_catpv(RETVAL, ",PAD_STATE");
#endif
#ifdef OPpDONT_INIT_GV
        else if ((o->op_type == OP_RV2GV) && (o->op_private & OPpDONT_INIT_GV))
		sv_catpv(RETVAL, ",DONT_INIT_GV");
#endif
        else if (o->op_type == OP_CONST) {
#ifdef OPpCONST_BARE
            if (o->op_private & OPpCONST_BARE)
                sv_catpv(RETVAL, ",BARE");
#endif
#ifdef OPpCONST_STRICT
            if (o->op_private & OPpCONST_STRICT)
                sv_catpv(RETVAL, ",STRICT");
#endif
#ifdef OPpCONST_ARYBASE
            if (o->op_private & OPpCONST_ARYBASE)
                sv_catpv(RETVAL, ",ARYBASE");
#endif
#ifdef OPpCONST_WARNING
            if (o->op_private & OPpCONST_WARNING)
                sv_catpv(RETVAL, ",WARNING");
#endif
#ifdef OPpCONST_ENTERED
            if (o->op_private & OPpCONST_ENTERED)
                sv_catpv(RETVAL, ",ENTERED");
#endif
#ifdef OPpCONST_NOVER
            if (o->op_private & OPpCONST_NOVER)
                sv_catpv(RETVAL, ",NOVER");
#endif
#ifdef OPpCONST_SHORTCIRCUIT
            if (o->op_private & OPpCONST_SHORTCIRCUIT)
                sv_catpv(RETVAL, ",SHORTCIRCUIT");
#endif
        }
#ifdef OPpFLIP_LINENUM
        else if (o->op_type == OP_FLIP) {
            if (o->op_private & OPpFLIP_LINENUM)
                sv_catpv(RETVAL, ",LINENUM");
        }
        else if (o->op_type == OP_FLOP) {
            if (o->op_private & OPpFLIP_LINENUM)
                sv_catpv(RETVAL, ",LINENUM");
        }
#endif
        else if (o->op_type == OP_RV2CV) {
#ifdef OPpLVAL_INTRO
            if (o->op_private & OPpLVAL_INTRO)
                sv_catpv(RETVAL, ",INTRO");
#endif
#ifdef OPpMAY_RETURN_CONSTANT
            if (o->op_private & OPpMAY_RETURN_CONSTANT)
                sv_catpv(RETVAL, ",MAY_RETURN_CONSTANT");
#endif
        }
#ifdef OPpEARLY_CV
        else if (o->op_type == OP_GV) {
            if (o->op_private & OPpEARLY_CV)
                sv_catpv(RETVAL, ",EARLY_CV");
        }
#endif
#ifdef OPpLIST_GUESSED
        else if (o->op_type == OP_LIST) {
            if (o->op_private & OPpLIST_GUESSED)
                sv_catpv(RETVAL, ",GUESSED");
        }
#endif
#ifdef OPpSLICE
        else if (o->op_type == OP_DELETE) {
            if (o->op_private & OPpSLICE)
                sv_catpv(RETVAL, ",SLICE");
        }
#endif
#ifdef OPpEXISTS_SUB
        else if (o->op_type == OP_EXISTS) {
            if (o->op_private & OPpEXISTS_SUB)
                sv_catpv(RETVAL, ",EXISTS_SUB");
        }
#endif
        else if (o->op_type == OP_SORT) {
#ifdef OPpSORT_NUMERIC
            if (o->op_private & OPpSORT_NUMERIC)
                sv_catpv(RETVAL, ",NUMERIC");
#endif
#ifdef OPpSORT_INTEGER
            if (o->op_private & OPpSORT_INTEGER)
                sv_catpv(RETVAL, ",INTEGER");
#endif
#ifdef OPpSORT_REVERSE
            if (o->op_private & OPpSORT_REVERSE)
                sv_catpv(RETVAL, ",REVERSE");
#endif
#ifdef OPpSORT_INPLACE
            if (o->op_private & OPpSORT_INPLACE)
                sv_catpv(RETVAL, ",INPLACE");
#endif
#ifdef OPpSORT_DESCEND
            if (o->op_private & OPpSORT_DESCEND)
                sv_catpv(RETVAL, ",DESCEND");
#endif
#ifdef OPpSORT_QSORT
            if (o->op_private & OPpSORT_QSORT)
                sv_catpv(RETVAL, ",QSORT");
#endif
#ifdef OPpSORT_STABLE
            if (o->op_private & OPpSORT_STABLE)
                sv_catpv(RETVAL, ",STABLE");
#endif
        }
#if defined(OPpDONE_SVREF) && (PERL_VERSION < 9)
        else if (o->op_type == OP_THREADSV) {
            if (o->op_private & OPpDONE_SVREF)
                sv_catpv(RETVAL, ",SVREF");
        }
#elsif defined(OPpDONE_SVREF)
        else if (o->op_private & OPpDONE_SVREF)
                sv_catpv(RETVAL, ",SVREF");
#endif
        else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
#ifdef OPpOPEN_IN_RAW
            if (o->op_private & OPpOPEN_IN_RAW)
                sv_catpv(RETVAL, ",IN_RAW");
#endif
#ifdef OPpOPEN_IN_CRLF
            if (o->op_private & OPpOPEN_IN_CRLF)
                sv_catpv(RETVAL, ",IN_CRLF");
#endif
#ifdef OPpOPEN_OUT_RAW
            if (o->op_private & OPpOPEN_OUT_RAW)
                sv_catpv(RETVAL, ",OUT_RAW");
#endif
#ifdef OPpOPEN_OUT_CRLF
            if (o->op_private & OPpOPEN_OUT_CRLF)
                sv_catpv(RETVAL, ",OUT_CRLF");
#endif
        }
        else if (o->op_type == OP_EXIT) {
#ifdef OPpEXIT_VMSISH
            if (o->op_private & OPpEXIT_VMSISH)
                sv_catpv(RETVAL, ",EXIST_VMSISH");
#endif
#ifdef OPpHUSH_VMSISH
            if (o->op_private & OPpHUSH_VMSISH)
                sv_catpv(RETVAL, ",HUSH_VMSISH");
#endif
        }
#ifdef OPpLVAL_INTRO
        if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
            sv_catpv(RETVAL, ",INTRO");
#endif
#ifdef OP_IS_FILETEST_ACCESS
# if (PERL_VERSION < 11)
	if (OP_IS_FILETEST_ACCESS(o)) {
# else
	if (OP_IS_FILETEST_ACCESS(o->op_type)) {
# endif
# ifdef OPpFT_ACCESS
            if (o->op_private & OPpFT_ACCESS)
                sv_catpv(RETVAL, ",FT_ACCESS");
# endif
# ifdef OPpFT_STACKED
            if (o->op_private & OPpFT_STACKED)
                sv_catpv(RETVAL, ",FT_STACKED");
# endif
	}
#endif
#ifdef OPpGREP_LEX
        else if (o->op_type == OP_MAPSTART  ||
		 o->op_type == OP_MAPWHILE  ||
                 o->op_type == OP_GREPSTART ||
                 o->op_type == OP_GREPWHILE ) {
            if (o->op_private & OPpGREP_LEX)
                sv_catpv(RETVAL, ",GREP_LEX");
	}
#endif
#ifdef OPpEVAL_HAS_HH
        else if (o->op_type == OP_ENTEREVAL ) {
            if (o->op_private & OPpEVAL_HAS_HH)
                sv_catpv(RETVAL, ",EVAL_HAS_HH");
	}
#endif

        if (SvCUR(RETVAL))
            sv_chop(RETVAL, SvPVX(RETVAL)+1);
    OUTPUT:
        RETVAL

MODULE = B::Flags		PACKAGE = B::SV

SV*
flagspv(sv, type=-1)
    B::SV sv
    I32 type
    U32 flags = NO_INIT
    U32 sv_type = NO_INIT
    CODE:
        RETVAL = newSVpvn("", 0);
        flags = SvFLAGS(sv);
        sv_type = SvTYPE(sv);
        if (type <= 0) {
#ifdef SVs_PADBUSY
        if (flags & SVs_PADBUSY)    sv_catpv(RETVAL, "PADBUSY,");
#endif
#ifdef SVs_PADSTALE
        if (flags & SVs_PADSTALE)   sv_catpv(RETVAL, "PADSTALE,");
#endif
        if (flags & SVs_PADTMP)     sv_catpv(RETVAL, "PADTMP,");
        if (flags & SVs_PADMY)      sv_catpv(RETVAL, "PADMY,");
        if (flags & SVs_TEMP)       sv_catpv(RETVAL, "TEMP,");
        if (flags & SVs_OBJECT)     sv_catpv(RETVAL, "OBJECT,");
        if (flags & SVs_GMG)        sv_catpv(RETVAL, "GMG,");
        if (flags & SVs_SMG)        sv_catpv(RETVAL, "SMG,");
        if (flags & SVs_RMG)        sv_catpv(RETVAL, "RMG,");

        if (flags & SVf_IOK)        sv_catpv(RETVAL, "IOK,");
        if (flags & SVf_NOK)        sv_catpv(RETVAL, "NOK,");
        if (flags & SVf_POK)        sv_catpv(RETVAL, "POK,");
        if (flags & SVf_ROK)  {
                                    sv_catpv(RETVAL, "ROK,");
            if (SvWEAKREF(sv))      sv_catpv(RETVAL, "WEAKREF,");
        }
        if (flags & SVf_OOK)        sv_catpv(RETVAL, "OOK,");
        if (flags & SVf_FAKE)       sv_catpv(RETVAL, "FAKE,");
        if (flags & SVf_READONLY)   sv_catpv(RETVAL, "READONLY,");
#ifdef SVf_BREAK
        if (flags & SVf_BREAK)      sv_catpv(RETVAL, "BREAK,");
#endif
        if (flags & SVf_AMAGIC)     sv_catpv(RETVAL, "OVERLOAD,");
        if (flags & SVp_IOK)        sv_catpv(RETVAL, "pIOK,");
        if (flags & SVp_NOK)        sv_catpv(RETVAL, "pNOK,");
        if (flags & SVp_POK)        sv_catpv(RETVAL, "pPOK,");
#ifdef SvVOK
        if (SvVOK(sv))              sv_catpv(RETVAL, "VOK,");
#endif
#ifdef SVphv_CLONEABLE /* since 5.8.8 */
        if ((flags & SVphv_CLONEABLE) && (sv_type == SVt_PVHV))
				    sv_catpv(RETVAL, "CLONEABLE,");
        else
#endif
#ifdef SVpgv_GP /* since 5.10 */
	  if ((flags & SVpgv_GP) && (sv_type == SVt_PVGV))
				    sv_catpv(RETVAL, "isGV_with_GP,");
          else
#endif
#ifdef SVpad_NAMELIST /* since 5.19.3 */
	  if ((flags & SVpad_NAMELIST) && (sv_type == SVt_PVAV))
				    sv_catpv(RETVAL, "PADNAMELIST,");
          else
#endif
#ifdef SVpad_NAME /* since 5.10 */
          if (flags & SVpad_NAME) {
            sv_catpv(RETVAL, "PADNAME,");
            if (flags & SVpad_TYPED)  sv_catpv(RETVAL, "TYPED,");
            if (flags & SVpad_OUR)    sv_catpv(RETVAL, "OUR,");
            if (flags & SVpad_STATE)  sv_catpv(RETVAL, "STATE,");
          }
          else
#endif
#ifdef SVprv_PCS_IMPORTED /* since 5.8.9, RV is a proxy for a constant */
          if (flags & SVf_ROK && flags & SVprv_PCS_IMPORTED)
				      sv_catpv(RETVAL, "PCS_IMPORTED,");
          else
#endif
          if (flags & SVp_SCREAM)     sv_catpv(RETVAL, "SCREAM,");
#ifdef SVpav_REAL
        if ((flags & SVpav_REAL) && (sv_type == SVt_PVAV))
            sv_catpv(RETVAL, "REAL,");
#endif
#ifdef SVpav_REIFY
        if ((flags & SVpav_REIFY) && (sv_type == SVt_PVAV)) 
            sv_catpv(RETVAL, "REIFY,");
#endif
	}
#ifdef SVf_IsCOW
        if (flags & SVf_IsCOW)
            sv_catpv(RETVAL, "IsCOW,");
        else
#endif
#ifdef SVf_THINKFIRST
        if (flags & SVf_THINKFIRST)
            sv_catpv(RETVAL, "THINKFIRST,");
#endif
        switch (type == -1 ? sv_type : type) {
        case SVt_PVCV:
        case SVt_PVFM:
            if (CvANON(sv))         sv_catpv(RETVAL, "ANON,");
#ifdef CvEVAL
            if (CvEVAL(sv))         sv_catpv(RETVAL, "EVAL,");
	    else if (CvUNIQUE(sv))  sv_catpv(RETVAL, "UNIQUE,");
#else
            if (CvUNIQUE(sv))       sv_catpv(RETVAL, "UNIQUE,");
#endif
            if (CvCLONE(sv))        sv_catpv(RETVAL, "CLONE,");
            if (CvCLONED(sv))       sv_catpv(RETVAL, "CLONED,");
#ifdef CvCONST
            if (CvCONST(sv))        sv_catpv(RETVAL, "CONST,");
#endif
            if (CvNODEBUG(sv))      sv_catpv(RETVAL, "NODEBUG,");
            if (SvCOMPILED(sv))     sv_catpv(RETVAL, "COMPILED,");
#ifdef CVf_BUILTIN_ATTRS
	    if (CvFLAGS(sv) == CVf_BUILTIN_ATTRS) 
	                            sv_catpv(RETVAL, "BUILTIN_ATTRS,");
	    else {
	      if (CvLVALUE(sv))     sv_catpv(RETVAL, "LVALUE,");
	      if (CvMETHOD(sv))     sv_catpv(RETVAL, "METHOD,");
	    }
#else
            if (CvLVALUE(sv))       sv_catpv(RETVAL, "LVALUE,");
            if (CvMETHOD(sv))       sv_catpv(RETVAL, "METHOD,");
#endif
#ifdef CvWEAKOUTSIDE
            if (CvWEAKOUTSIDE(sv))  sv_catpv(RETVAL, "WEAKOUTSIDE,");
#endif
#ifdef CvISXSUB
            if (CvISXSUB(sv))       sv_catpv(RETVAL, "ISXSUB,");
#endif
#ifdef CvCVGV_RC
            if (CvCVGV_RC(sv))      sv_catpv(RETVAL, "CVGV_RC,");
#endif
            break;
        case SVt_PVHV:
            if (HvSHAREKEYS(sv))    sv_catpv(RETVAL, "SHAREKEYS,");
            if (HvLAZYDEL(sv))      sv_catpv(RETVAL, "LAZYDEL,");
            break;
        case SVt_PVBM: /* == PVMG */
            if (!(flags & SVp_SCREAM)) {
                if (SvTAIL(sv))         sv_catpv(RETVAL, "TAIL,");
                if (SvVALID(sv))        sv_catpv(RETVAL, "VALID,");
            }
            break;
        case SVt_PVGV:
            if (GvINTRO(sv))        sv_catpv(RETVAL, "INTRO,");
            if (GvMULTI(sv))        sv_catpv(RETVAL, "MULTI,");
#ifdef GvSHARED
            if (GvSHARED(sv))       sv_catpv(RETVAL, "SHARED,");
#endif
            if (GvASSUMECV(sv))     sv_catpv(RETVAL, "ASSUMECV,");
            if (GvIN_PAD(sv))       sv_catpv(RETVAL, "IN_PAD,");
            if (GvIMPORTED(sv)) {
                sv_catpv(RETVAL, "IMPORTED");
                if (GvIMPORTED(sv) == GVf_IMPORTED)
                    sv_catpv(RETVAL, "_ALL,");
                else {
                    sv_catpv(RETVAL, "(");
                    if (GvIMPORTED_SV(sv))  sv_catpv(RETVAL, " SV");
                    if (GvIMPORTED_AV(sv))  sv_catpv(RETVAL, " AV");
                    if (GvIMPORTED_HV(sv))  sv_catpv(RETVAL, " HV");
                    if (GvIMPORTED_CV(sv))  sv_catpv(RETVAL, " CV");
                    sv_catpv(RETVAL, " ),");
                }
            }
            /* FALL THROUGH */
        default:
            if (SvEVALED(sv))       sv_catpv(RETVAL, "EVALED,");
            if (SvIsUV(sv))         sv_catpv(RETVAL, "IsUV,");
            if (SvUTF8(sv))         sv_catpv(RETVAL, "UTF8");
            break;
        }
        if (SvCUR(RETVAL) && (*(SvEND(RETVAL) - 1) == ',')) {
#if defined(__clang__) && __clang_major__ <= 1 && __clang_minor__ < 8
	  --SvCUR(RETVAL);
	  SvPVX(RETVAL)[SvCUR(RETVAL)] = '\0';
#else
	  SvPVX(RETVAL)[--SvCUR(RETVAL)] = '\0';
#endif
	}
    OUTPUT:
        RETVAL
perl-B-Flags-0.10/MANIFEST000064400000000000000000000001061221215251100147210ustar00rootroot00000000000000Changes
Flags.pm
Flags.xs
typemap
MANIFEST
Makefile.PL
README
test.pl
perl-B-Flags-0.10/Makefile.PL000064400000000000000000000011221221215251100155410ustar00rootroot00000000000000use ExtUtils::MakeMaker;
WriteMakefile
  (
   'NAME'		=> 'B::Flags',
   'VERSION_FROM'	=> 'Flags.pm',
   'AUTHOR'             => 'Simon Cozens <simon@cpan.org>, Reini Urban <rurban@cpan.org>',
   'ABSTRACT_FROM'      => 'Flags.pm',
   'SIGN'               => 1,
   ($ExtUtils::MakeMaker::VERSION gt '6.46' ?
    ('META_MERGE'  =>
     {
      resources =>
      {
       license     => 'http://dev.perl.org/licenses/',
       repository  => 'http://github.com/rurban/b-flags',
      },
     }
    ) : ()),
  );

package MY;

sub depend { "README : Flags.pm\n\tpod2text Flags.pm > README\n"; }

perl-B-Flags-0.10/test.pl000064400000000000000000000032751221215251100151160ustar00rootroot00000000000000use Test::More tests => 16;
BEGIN { use_ok( 'B::Flags' ); }

ok B::main_root->flagspv =~ /VOID/, "main_root VOID";
ok B::main_root->privatepv =~ /REFCOUNTED/, "main_root->privatepv REFCOUNTED";
ok B::svref_2object(\3)->flagspv =~ /READONLY/, "warning 3 READONLY";

# for AV, CV and GV print its flags combined and splitted
my @a = (0..4);
my $SVt_PVAV = $] < 5.010 ? 10 : 11;
my $EVALED = $] < 5.010 ? '' : 'EVALED';
my $av = B::svref_2object( \@a );
ok $av->flagspv =~ /^PAD/, "AV default ".$av->flagspv." both flags";
ok $av->flagspv($SVt_PVAV) eq $EVALED, $av->flagspv($SVt_PVAV)." AvFLAGS only";
ok $av->flagspv(0) eq $av->flagspv, $av->flagspv(0)." SvFLAGS only";

sub mycv {my $n=1; 1}
my $cv = B::svref_2object( \&main::mycv );
my $pad = ($cv->PADLIST->ARRAY)[1];
SKIP: {
  skip "need AvFLAGS for pad",3 if $] < 5.010;
  ok $pad->flagspv =~ /REAL,EVALED$/, "PAD default ".$pad->flagspv." both flags";
  ok $pad->flagspv($SVt_PVAV) eq 'EVALED', $pad->flagspv($SVt_PVAV)." AvFLAG only";
  ok $pad->flagspv(0) =~ /REAL,EVALED$/, $pad->flagspv(0)." SvFLAGS only - fallthrough";
}

sub lvalcv:lvalue {my $n=1;}
my $SVt_PVCV = $] < 5.010 ? 12 : 13;
my $cv = B::svref_2object( \&main::lvalcv );
ok $cv->flagspv =~ /LVALUE/, "LVCV ".$cv->flagspv." SvFLAGS+CvFLAGS";
ok $cv->flagspv($SVt_PVCV) =~ /^LVALUE/, $cv->flagspv($SVt_PVCV)." CvFLAGS only";
ok $cv->flagspv(0) !~ /LVALUE/, "LVCV ".$cv->flagspv(0)." SvFLAGS only";

my $SVt_PVGV = $] < 5.010 ? 13 : 9;
my $gv = B::svref_2object( \*mycv );
ok $gv->flagspv =~ /MULTI/, "GV ".$gv->flagspv." SvFLAGS+GvFLAGS";
ok $gv->flagspv($SVt_PVGV) =~ /^(MULTI|THINKFIRST,MULTI)/, $gv->flagspv($SVt_PVGV)." GvFLAGS only";
ok $gv->flagspv(0) !~ /MULTI/, $gv->flagspv(0)." SvFLAGS only";
perl-B-Flags-0.10/typemap000064400000000000000000000022021221215251100151710ustar00rootroot00000000000000TYPEMAP

B::OP		T_OP_OBJ
B::UNOP		T_OP_OBJ
B::BINOP	T_OP_OBJ
B::LOGOP	T_OP_OBJ
B::LISTOP	T_OP_OBJ
B::PMOP		T_OP_OBJ
B::SVOP		T_OP_OBJ
B::PADOP	T_OP_OBJ
B::PVOP		T_OP_OBJ
B::CVOP		T_OP_OBJ
B::LOOP		T_OP_OBJ
B::COP		T_OP_OBJ

B::SV		T_SV_OBJ
B::PV		T_SV_OBJ
B::IV		T_SV_OBJ
B::NV		T_SV_OBJ
B::PVMG		T_SV_OBJ
B::PVLV		T_SV_OBJ
B::BM		T_SV_OBJ
B::RV		T_SV_OBJ
B::GV		T_SV_OBJ
B::CV		T_SV_OBJ
B::HV		T_SV_OBJ
B::AV		T_SV_OBJ
B::IO		T_SV_OBJ

B::MAGIC	T_MG_OBJ
SSize_t		T_IV
STRLEN		T_IV
PADOFFSET	T_UV

INPUT
T_OP_OBJ
	if (SvROK($arg)) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = INT2PTR($type,tmp);
	}
	else
	    croak(\"$var is not a reference\")

T_SV_OBJ
	if (SvROK($arg)) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = INT2PTR($type,tmp);
	}
	else
	    croak(\"$var is not a reference\")

T_MG_OBJ
	if (SvROK($arg)) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = INT2PTR($type,tmp);
	}
	else
	    croak(\"$var is not a reference\")

OUTPUT
T_OP_OBJ
	sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var));

T_SV_OBJ
	make_sv_object(aTHX_ ($arg), (SV*)($var));


T_MG_OBJ
	sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
 
дизайн и разработка: Vladimir Lettiev aka crux © 2004-2005, Andrew Avramenko aka liks © 2007-2008
текущий майнтейнер: Michael Shigorin