view release on metacpan or  search on metacpan

ext/XS-APItest/APItest.pm  view on Meta::CPAN

package XS::APItest;

use strict;
use warnings;
use Carp;

our $VERSION = '1.43';

require XSLoader;

# Export everything since these functions are only used by a test script
# Export subpackages too - in effect, export all their routines into us, then
# export everything from us.
sub import {
    my $package = shift;
    croak ("Can't export for '$package'") unless $package eq __PACKAGE__;
    my $exports;
    @{$exports}{@_} = () if @_;

    my $callpkg = caller;

    my @stashes = ('XS::APItest::', \%XS::APItest::);
    while (my ($stash_name, $stash) = splice @stashes, 0, 2) {
	while (my ($sym_name, $glob) = each %$stash) {
	    if ($sym_name =~ /::$/) {
		# Skip any subpackages that are clearly OO
		next if *{$glob}{HASH}{'new'};
		# and any that have AUTOLOAD
		next if *{$glob}{HASH}{AUTOLOAD};
		push @stashes, "$stash_name$sym_name", *{$glob}{HASH};
	    } elsif (ref $glob eq 'SCALAR' || *{$glob}{CODE}) {
		if ($exports) {
		    next if !exists $exports->{$sym_name};
		    delete $exports->{$sym_name};
		}
		no strict 'refs';
		*{"$callpkg\::$sym_name"} = \&{"$stash_name$sym_name"};
	    }
	}
    }
    foreach (keys %{$exports||{}}) {
	next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock|stmtasexpr|stmtsasexpr|loopblock|blockasexpr|swaplabel|labelconst|arrayfullexpr|arraylistexpr|arraytermexpr|arrayarithexpr|arrayexprflags|subsignature|DEFSV|with_vars|join_...
	$^H{"XS::APItest/$_"} = 1;
	delete $exports->{$_};
    }
    if ($exports) {
	my @carp = keys %$exports;
	if (@carp) {
	    croak(join '',
		  (map "\"$_\" is not exported by the $package module\n", sort @carp),
		  "Can't continue after import errors");
	}
    }
}

use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);

# Do these here to verify that XS code and Perl code get called at the same
# times
BEGIN {
    $BEGIN_called_PP++;
}
UNITCHECK {
    $UNITCHECK_called_PP++;
};
{
    # Need $W false by default, as some tests run under -w, and under -w we
    # can get warnings about "Too late to run CHECK" block (and INIT block)
    no warnings 'void';
    CHECK {
	$CHECK_called_PP++;
    }
    INIT {
	$INIT_called_PP++;
    }
}
END {
    $END_called_PP++;
}

if ($WARNINGS_ON_BOOTSTRAP) {
    XSLoader::load();
} else {
    # More CHECK and INIT blocks that could warn:
    local $^W;
    XSLoader::load();
}

# This XS function needs the lvalue attr applied.
eval 'use attributes __PACKAGE__, \\&lv_temp_object, "lvalue"; 1' or die;

1;
__END__

=head1 NAME

XS::APItest - Test the perl C API

=head1 SYNOPSIS

  use XS::APItest;
  print_double(4);

  use XS::APItest qw(rpn calcrpn);
  $triangle = rpn($n $n 1 + * 2 /);
  calcrpn $triangle { $n $n 1 + * 2 / }

=head1 ABSTRACT

This module tests the perl C API. Also exposes various bit of the perl
internals for the use of core test scripts.

=head1 DESCRIPTION

This module can be used to check that the perl C API is behaving
correctly. This module provides test functions and an associated
test script that verifies the output.

This module is not meant to be installed.

=head2 EXPORT

Exports all the test functions: