view release on metacpan or  search on metacpan

t/error.tx  view on Meta::CPAN

package main;

use strict;
use warnings;

use Mac::Pasteboard qw{coreFoundationUnknownErr};
use Test::More 0.88;

sub test_error (@);	## no critic (ProhibitSubroutinePrototypes)

Mac::Pasteboard->set (fatal => 0);
my $pb = Mac::Pasteboard->new ();
if (Mac::Pasteboard->get ('status') == coreFoundationUnknownErr) {
    plan skip_all => 'No access to desktop (maybe running as ssh session or cron job?)';
    exit;
}
$pb or die Mac::Pasteboard->get ('status');

$pb->clear ();
my $data;
eval {
    $data = $pb->paste();
    1;
} or do {
    $ENV{DEVELOPER_DEBUG} and warn $@;
    $data = $pb->get ('status');
};

test_error $data, -25133, 'Retrieve from cleared pasteboard.';

$pb->set (missing_ok => 1);
eval {
    $data = $pb->paste();
    1;
} or do {
    $ENV{DEVELOPER_DEBUG} and warn $@;
    $data = $pb->get ('status');
};
test_error $data, undef,
    'Retrieve from cleared pasteboard, if missing_ok is true.';

SKIP: {
    $Mac::Pasteboard::USE_PBCOPY
	and skip 'Duplicate data test fails if spawning pbcopy', 1;

    $pb->copy ('original data');
    eval {
	$data = $pb->copy ('different data');
	1;
    } or do {
	$ENV{DEVELOPER_DEBUG} and warn $@;
	$data = $pb->get ('status');
    };
    test_error $data, -25134, 'Duplicate copy.'
	or diag 'Status was ', explain $data;
}

done_testing;

sub test_error (@) {	## no critic (ProhibitSubroutinePrototypes, RequireArgUnpacking)
    my $got = shift;
    my $want = shift;
    my ($ext_got, $ext_want);
    ($got, $ext_got) = groom_error ($got);
    ($want, $ext_want) = groom_error ($want);
    @_ = ( ( defined $want ? $want == $got : ! defined $got ), "@_" );
    goto &ok;
}

sub groom_error {
    my $data = shift;
    if (!defined $data) {
	return ($data, 'undef');
##    } elsif (!ref $data) {