Class-CompiledC

 view release on metacpan or  search on metacpan

lib/Class/CompiledC.pm  view on Meta::CPAN

our %funcs;
our %extfuncs;
our %code;
our %scheduled;
our %types;
our %EXPORT_TAGS;
our @EXPORT_OK;
our $re_ft;
our $re_ft_isa;

sub __circumPrint($$$);
sub __include;
sub __baseref($$);
sub __hashref($);
sub __arrayref($);
sub __coderef($);
sub __fetchSymbolName($);
sub __promoteFieldTypeToMacro($);
sub __parseFieldType;


$re_ft     = qr/^(?:\s*)(int|float|number|string|ref|arrayref|hashref|
                         coderef|object|regexpref|any|uint)(?:\s*)/xi;

$re_ft_isa = qr/^(?:\s*)isa(?:\s*)\((?:\s*)([\w:]*)(?:\s*)\)(?:\s*)/i;

=head1 ABSTRACT

lib/Class/CompiledC.pm  view on Meta::CPAN

  __circumPrint TEXT, LEFT, RIGHT
  Type: Subroutine.
  Export: on request.
  Prototype: $$$

Utitlity function, concatenates it's arguments, in the order
C<$_[1].$_[0].$_[1]> and returns the resulting string. Does not print anything.

=cut

sub __circumPrint($$$)
{
        return $_[1].$_[0].$_[2];
}

=head3 __include

  __include I<NOTHING>
  Type: Subroutine.
  Export: on request.
  Prototype: none

lib/Class/CompiledC.pm  view on Meta::CPAN

  __baseref REFERENCE, TYPE
  Type: Subroutine.
  Export: on request.
  Prototype: $$

Determines if REFERENCE is actually a reference and and is of type TYPE.

=cut

sub __baseref($$)
{
        defined $_[0] && ref $_[0] && ref $_[0] eq $_[1];
}

=head3 __hashref

  __hashref REFERENCE
  Type: Subroutine.
  Export: on request.
  Prototype: $

Determines if REFERENCE is actually a hash reference.
Utitlizes C<__baseref>.

=cut

sub __hashref($)
{
        __baseref $_[0], 'HASH';
}

=head3 __arrayref

  __arrayref REFERENCE
  Type: Subroutine.
  Export: on request.
  Prototype: $

Determines if REFERENCE is actually a array reference.
Utitlizes C<__baseref>.

=cut

sub __arrayref($)
{
        __baseref $_[0], 'ARRAY';
}

=head3 __coderef

  __coderef REFERENCE
  Type: Subroutine.
  Export: on request.
  Prototype: $

Determines if REFERENCE is actually a code reference.
Utitlizes C<__baseref>.

=cut

sub __coderef($)
{
        __baseref($_[0], 'CODE')
}

=head3 __fetchSymbolName

  __fetchSymbolName GLOBREF
  Type: Subroutine.
  Export: on request.
  Prototype: $

Returns the Symbol name from the glob reference GLOBREF.
Croaks if GLOBREF acutally isn't a glob reference.

=cut

sub __fetchSymbolName($)
{
        no strict 'refs';
        my $symbol = shift;

        __baseref $symbol, 'GLOB' or croak 'not a GLOB reference';

        return *$symbol{NAME};
}

=head3 __promoteFieldTypeToMacro

lib/Class/CompiledC.pm  view on Meta::CPAN

  __promoteFieldTypeToMacro FIELDTYPE
  Type: Subroutine.
  Export: on request.
  Prototype: none

Takes a fieldtype specfication, and returns a C<C> macro for doing the test.
Does not handle parametric types like C<isa>. See C<__parseFieldType> for that.

=cut

sub __promoteFieldTypeToMacro($)
{
        my $type = shift;

        return '' unless ($type);
        return '' if     ($type =~ /^any$/i);
        return sprintf '__CHECK(__IS%s(__ARG0), "%s")', uc $type, $type;
}

=head3 __parseFieldType

t/Class-CompiledC.t  view on Meta::CPAN

no warnings qw'prototype';

use_ok('Class::CompiledC');

{
        local $_ = 'foobar';
        is (Class::CompiledC::__include(), "\n#include foobar\n", 
            'test __include');
}

sub dies_with(&$$)
{
        my $sub  = shift;
        my $die  = shift;
        my $text = shift;
        my $tmp;
        my $res = eval {&$sub};
        $tmp = $@; 
        
        warn "is $tmp\nresult is $res\n" unless $tmp =~ $die;
        
        ok ($tmp =~ $die, $text);
}

sub no_die(&$)
{
        my $sub  = shift;
        my $text = shift;
        
        local $@;
        
        eval {&$sub};
        
        pass($text) unless  $@;
        fail($text." \n expected no die but got '$@'") if $@;