perlmod/test.pl

#!/usr/bin/env perl

use v5.28.0;

use POSIX ();

# The nasty ones:
use Storable;
use Clone;

use lib '.';
use RSPM::Bless;
use RSPM::Foo142;
use RSPM::Option;
use RSPM::Magic;

STDOUT->autoflush;
# Let's combine stderr and stdout:
POSIX::dup2(fileno(STDOUT), fileno(STDERR));

my $v = RSPM::Bless->new("Hello");
$v->something();
$v->something_nonraw();
my ($a, $b, $c) = $v->multi_return();
say "Got ($a, $b, $c)";
my @ret = $v->multi_return();
say "Got: ".scalar(@ret)." values: @ret";

$v->another(54);

my $param = { a => 1 };
my $s = "Hello You";
print "These should be called with a valid substr:\n";
RSPM::Foo142::test(substr($s, 3, 3));
RSPM::Foo142::teststr(substr($s, 3, 3));
print "Parameter exists: " . (exists($param->{x}) ? "YES" : "NO") . "\n";
RSPM::Foo142::test($param->{x});
print "Was auto-vivified: " . (exists($param->{x}) ? "YES" : "NO") . "\n";
RSPM::Foo142::teststr($param->{x});

my $a = "Can I have some coffee please?\n";
print $a;
my $b = RSPM::Foo142::test_serde($a);
print $b;
my $c = RSPM::Foo142::test_serde($b);
print $c;

use utf8;
binmode STDOUT, ':utf8';
my $a = "Can I have some ☕ please?\n";
print $a;
my $b = RSPM::Foo142::test_serde($a);
print $b;
my $c = RSPM::Foo142::test_serde($b);
print $c;

sub to_string {
    my ($param) = @_;

    my $state = $param->{tristate};
    $state = int($state) if defined($state);

    my $a;
    if (defined($state)) {
	$a = $state ? "Some(true)" : "Some(false)";
    } else {
	$a = "None";
    }

    my $b = RSPM::Option::to_string($state);
    my $c = RSPM::Option::struct_to_string({ 'tristate' => $state });

    print "$a\n";
    print "$b\n";
    print "$c\n";
}

to_string({ 'tristate' => '0' });
to_string({ 'tristate' => '1' });
to_string({ 'tristate' => undef });

my $ref1 = { x => "x was stored" };
my $ref2 = RSPM::Foo142::test_refs({ copied => "copied string", reference => $ref1 });
print($ref1->{x}, "\n");
$ref2->{x} = "x was changed";
print($ref1->{x}, "\n");

my $magic = RSPM::Magic->new('magic test');
$magic->call();

sub test_unsafe_clone($) {
    my ($bad) = @_;
    eval { $bad->call() };
    if (!$@) {
        die "cloned object not properly detected!\n";
    } elsif ($@ ne "value blessed into RSPM::Magic did not contain its declared magic pointer\n") {
        die "cloned object error message changed to: [$@]\n";
    }
    undef $bad;
    print("unsafe dclone dropped\n");
}

print("Testing unsafe dclone\n");
test_unsafe_clone(Storable::dclone($magic));

print("Testing unsafe clone\n");
test_unsafe_clone(Clone::clone($magic));
undef $magic;

print("Testing enum deserialization\n");
my $ra = RSPM::Foo142::test_enums("something");
die "unexpected result from test_enums: $ra\n" if $ra ne 'result-a';

print("Testing optional parameters\n");
RSPM::Foo142::test_trailing_optional(1, 99);
RSPM::Foo142::test_trailing_optional(2, undef);
RSPM::Foo142::test_trailing_optional(3);

print("Substring test\n");
my $orig = "OneTwoThree";
my $sub = RSPM::Foo142::test_substr_return($orig);
print("[$orig] [$sub]\n");

my $ok = RSPM::Foo142::test_deserialized_error(0);
die "test_deserialized_error failed to set errno value\n" if $! != 77;
die "test_deserialized_error failed to return a value\n" if $ok ne 'worked';
$ok = eval { RSPM::Foo142::test_deserialized_error(1) };
die "test_deserialized_error error case returned a value\n" if defined $ok;
my $err = $@;
die "test_deserialized_error error is not a hash\n" if ref($err) ne 'HASH';
die "structured error has invalid fields\n" if join(',', sort(keys(%$err))) ne 'a,b';
print('error type: { a: ', $err->{a}, ', b: ', $err->{b}, " }\n");