view release on metacpan or  search on metacpan

lib/Assert/Conditional.pm  view on Meta::CPAN

#!/usr/bin/env perl
# ^^^^^^ !!!!!! ^^^^^^^
# Yes, this module really is supposed to have a #!
# line and be an executable script. See the end of the file
# for why!

package Assert::Conditional;

use v5.12;
use utf8;
use strict;
use warnings;

use version 0.77;
our $VERSION = version->declare("0.010");

use parent "Exporter::ConditionalSubs";  # inherits from Exporter

use namespace::autoclean;

use Attribute::Handlers;
use Assert::Conditional::Utils ":all";
use Carp qw(carp croak cluck confess);
use POSIX ":sys_wait_h";

use Scalar::Util qw{
    blessed
    looks_like_number
    openhandle
    refaddr
    reftype
};

use Unicode::Normalize qw{
    NFC    checkNFC
    NFD    checkNFD
    NFKC   checkNFKC
    NFKD   checkNFKD
};

# But these are private internal functions that we
# choose not to expose even if fully qualified,
# and so declaring them here in front of the
# imminent namespace::clean will make sure of that.

 sub _coredump_message    ( ;$  ) ;
 sub _get_invocant_type   (  $  ) ;
 sub _promote_to_arrayref (  $  ) ;
 sub _promote_to_hashref  (  $  ) ;
 sub _promote_to_typeref  (  $$ ) ;
 sub _run_code_test       (  $$ ) ;
 sub _signum_message      (  $  ) ;
 sub _WIFCORED            ( ;$  ) ;

# Need to be able to measure coverage with Devel::Cover
# of stuff we would normally get rid of.
use if !$ENV{HARNESS_ACTIVE}, "namespace::clean";

#######################################################################

# First declare our Exporter vars:
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);

# Then thanks to this little guy....
sub  Assert;

# Now those have by now all been fully populated *during compilation*,
# so it only remains to re-collate them into pleasant alphabetic order:
@$_ = uca_sort @$_ for \@EXPORT_OK, values %EXPORT_TAGS;

sub  assert_ainta                             (  $@               ) ;
sub  assert_alnum                             (  $                ) ;
sub  assert_alphabetic                        (  $                ) ;
sub  assert_anyref                            (  $                ) ;
sub  assert_argc                              ( ;$                ) ;
sub  assert_argc_max                          (  $                ) ;
sub  assert_argc_min                          (  $                ) ;
sub  assert_argc_minmax                       (  $$               ) ;
sub  assert_array_length                      ( \@ ;$             ) ;

lib/Assert/Conditional.pm  view on Meta::CPAN

    my($wstat) = @_ ? $_[0] : $?;
    my $signo = WTERMSIG($wstat);
    my $sigmsg = _signum_message($signo);
    _WIFCORED($wstat)           || botch "exit value $wstat indicates signal $sigmsg but no core dump";
}

sub assert_no_coredump(;$)
    :Assert( qw[process] )
{
    my($wstat) = @_ ? $_[0] : $?;
    my $cored = $wstat & 128;   # not standard; too hard to fish from real sys/wait.h
    return unless _WIFCORED($wstat);
    return unless $cored;
    my $signo  = WTERMSIG($wstat);
    my $sigmsg = _signum_message($signo);
    botch "exit value $wstat shows process died of a $sigmsg and dumped core";
}

sub assert_exited(;$)
    :Assert( qw[process] )
{
    &assert_legal_exit_status;
    my($wstat) = @_ ? $_[0] : $?;
    return if WIFEXITED($wstat);
    &assert_signalled;
    my $signo  = WTERMSIG($wstat);
    my $sigmsg = _signum_message($signo);
    my $cored  = _coredump_message($wstat);
    botch "exit value $wstat shows process did not exit but rather died of $sigmsg$cored";
}

sub assert_happy_exit(;$)
    :Assert( qw[process] )
{
    &assert_exited;
    my($wstat) = @_ ? $_[0] : $?;
    my $exit = WEXITSTATUS($wstat);
    $exit == 0                  || botch "exit status $exit is not a happy exit";
}

sub assert_sad_exit(;$)
    :Assert( qw[process] )
{
    &assert_exited;
    my($wstat) = @_ ? $_[0] : $?;
    my $exit = WEXITSTATUS($wstat);
    $exit != 0                  || botch "exit status 0 is an unexpectedly happy exit";
}

# If you actually *execute*(!) this module as though it were a perl
# script rather than merely require or compile it, it dumps out its
# export table like the pmexp tool from the pmtools distribution does.
# If moreover the ASSERT_CONDITIONAL_BUILD_POD envariable is true, then
# this actually generates pod you can use directly. This is used by the
# etc/generate-exporter-pod script from the source directory; this
# script is not installed, and is just a helper.

exit !dump_exports(@ARGV) unless his_is_require(-1);

# This can't execute at the "normal" time or else
# namespace::autoclean's call Sub::Identify freaks:
UNITCHECK { close(DATA) if defined fileno(DATA) }

1;


# This has to be __DATA__ not __END__ for the self-executing
# trick to work right.
__DATA__

=encoding utf8

=head1 NAME

Assert::Conditional - conditionally-compiled code assertions

=head1 SYNOPSIS

    # use them all unconditionally
    use Assert::Conditional qw(:all -if 1);

    # Use them based on some external conditional available
    # at compile time.
    use Assert::Conditional qw(:all)
        => -if => ( $ENV{DEBUG} && ! $ENV{NDEBUG} );

    # Use them based on some external conditional available
    # at compile time.
    use Assert::Conditional qw(:all)
        => -unless => $ENV{RUNTIME} eq "production";

    # Method that should be called in list context with two array refs
    # as arguments, and which should have both a "cross_product" and
    # a "cross_tees" method available to it.

    sub some_method {
        assert_list_context();
        assert_object_method();

        assert_argc(3);
        my($self, $left, $right) = @_;

        assert_arrayref($left);
        assert_arrayref($right);

        assert_can($self, "cross_product", "cross_tees");

        ...

        assert_happy_code { $i > $j };

        ...
    }

=head1 DESCRIPTION

C programmers have always had F<assert.h> to conditionally compile
assertions into their programs, but options available for Perl programmers
are not so convenient.

Several assertion modules related to assertions exist on CPAN, but none