2021-02-16 10:42:10 +01:00
#!/usr/bin/env perl
use v5 .28 .0 ;
2021-10-27 11:37:45 +02:00
use POSIX ( ) ;
2021-10-27 15:42:19 +02:00
# The nasty ones:
use Storable ;
use Clone ;
2021-02-16 10:42:10 +01:00
use lib '.' ;
use RSPM::Bless ;
2021-06-08 11:28:01 +02:00
use RSPM::Foo142 ;
2021-07-16 16:34:00 +02:00
use RSPM::Option ;
2021-10-27 11:37:45 +02:00
use RSPM::Magic ;
2021-02-16 10:42:10 +01:00
2021-07-19 09:37:08 +02:00
STDOUT - > autoflush ;
2021-10-27 11:37:45 +02:00
# Let's combine stderr and stdout:
POSIX:: dup2 ( fileno ( STDOUT ) , fileno ( STDERR ) ) ;
2021-07-19 09:37:08 +02:00
2021-02-16 10:42:10 +01:00
my $ v = RSPM::Bless - > new ( "Hello" ) ;
$ v - > something ( ) ;
2021-10-14 13:40:06 +02:00
$ v - > something_nonraw ( ) ;
2021-02-16 10:42:10 +01:00
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 ) ;
2021-06-08 11:28:01 +02:00
my $ param = { a = > 1 } ;
my $ s = "Hello You" ;
2021-06-10 10:14:04 +02:00
print "These should be called with a valid substr:\n" ;
2021-06-08 11:28:01 +02:00
RSPM::Foo142:: test ( substr ( $ s , 3 , 3 ) ) ;
RSPM::Foo142:: teststr ( substr ( $ s , 3 , 3 ) ) ;
2021-06-10 10:14:04 +02:00
print "Parameter exists: " . ( exists ( $ param - > { x } ) ? "YES" : "NO" ) . "\n" ;
2021-06-08 11:28:01 +02:00
RSPM::Foo142:: test ( $ param - > { x } ) ;
2021-06-10 10:14:04 +02:00
print "Was auto-vivified: " . ( exists ( $ param - > { x } ) ? "YES" : "NO" ) . "\n" ;
2021-06-08 11:28:01 +02:00
RSPM::Foo142:: teststr ( $ param - > { x } ) ;
2021-06-23 10:58:31 +02:00
2021-07-02 11:32:30 +02:00
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 ;
2021-07-16 16:34:00 +02:00
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 } ) ;
2021-10-14 15:13:32 +02:00
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" ) ;
2021-10-27 11:37:45 +02:00
my $ magic = RSPM::Magic - > new ( 'magic test' ) ;
$ magic - > call ( ) ;
2021-10-27 15:42:19 +02:00
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" ) ;
2021-10-27 11:37:45 +02:00
}
2021-10-27 15:42:19 +02:00
print ( "Testing unsafe dclone\n" ) ;
test_unsafe_clone ( Storable:: dclone ( $ magic ) ) ;
print ( "Testing unsafe clone\n" ) ;
test_unsafe_clone ( Clone:: clone ( $ magic ) ) ;
2021-11-05 10:14:19 +01:00
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' ;