]>
Commit | Line | Data |
---|---|---|
e95a2c0a WB |
1 | #!/usr/bin/env perl |
2 | ||
3 | use v5.28.0; | |
4 | ||
1521415b WB |
5 | use POSIX (); |
6 | ||
1e46bfbe WB |
7 | # The nasty ones: |
8 | use Storable; | |
9 | use Clone; | |
10 | ||
e95a2c0a WB |
11 | use lib '.'; |
12 | use RSPM::Bless; | |
61143f5d | 13 | use RSPM::Foo142; |
93eaead2 | 14 | use RSPM::Option; |
1521415b | 15 | use RSPM::Magic; |
e95a2c0a | 16 | |
0864428b | 17 | STDOUT->autoflush; |
1521415b WB |
18 | # Let's combine stderr and stdout: |
19 | POSIX::dup2(fileno(STDOUT), fileno(STDERR)); | |
0864428b | 20 | |
e95a2c0a WB |
21 | my $v = RSPM::Bless->new("Hello"); |
22 | $v->something(); | |
245de6dd | 23 | $v->something_nonraw(); |
e95a2c0a WB |
24 | my ($a, $b, $c) = $v->multi_return(); |
25 | say "Got ($a, $b, $c)"; | |
26 | my @ret = $v->multi_return(); | |
27 | say "Got: ".scalar(@ret)." values: @ret"; | |
28 | ||
29 | $v->another(54); | |
61143f5d WB |
30 | |
31 | my $param = { a => 1 }; | |
32 | my $s = "Hello You"; | |
b5c53f3d | 33 | print "These should be called with a valid substr:\n"; |
61143f5d WB |
34 | RSPM::Foo142::test(substr($s, 3, 3)); |
35 | RSPM::Foo142::teststr(substr($s, 3, 3)); | |
b5c53f3d | 36 | print "Parameter exists: " . (exists($param->{x}) ? "YES" : "NO") . "\n"; |
61143f5d | 37 | RSPM::Foo142::test($param->{x}); |
b5c53f3d | 38 | print "Was auto-vivified: " . (exists($param->{x}) ? "YES" : "NO") . "\n"; |
61143f5d | 39 | RSPM::Foo142::teststr($param->{x}); |
fa780264 | 40 | |
83ac604e WB |
41 | my $a = "Can I have some coffee please?\n"; |
42 | print $a; | |
43 | my $b = RSPM::Foo142::test_serde($a); | |
44 | print $b; | |
45 | my $c = RSPM::Foo142::test_serde($b); | |
46 | print $c; | |
47 | ||
48 | use utf8; | |
49 | binmode STDOUT, ':utf8'; | |
50 | my $a = "Can I have some ☕ please?\n"; | |
51 | print $a; | |
52 | my $b = RSPM::Foo142::test_serde($a); | |
53 | print $b; | |
54 | my $c = RSPM::Foo142::test_serde($b); | |
55 | print $c; | |
93eaead2 FE |
56 | |
57 | sub to_string { | |
58 | my ($param) = @_; | |
59 | ||
60 | my $state = $param->{tristate}; | |
61 | $state = int($state) if defined($state); | |
62 | ||
63 | my $a; | |
64 | if (defined($state)) { | |
65 | $a = $state ? "Some(true)" : "Some(false)"; | |
66 | } else { | |
67 | $a = "None"; | |
68 | } | |
69 | ||
70 | my $b = RSPM::Option::to_string($state); | |
71 | my $c = RSPM::Option::struct_to_string({ 'tristate' => $state }); | |
72 | ||
73 | print "$a\n"; | |
74 | print "$b\n"; | |
75 | print "$c\n"; | |
76 | } | |
77 | ||
78 | to_string({ 'tristate' => '0' }); | |
79 | to_string({ 'tristate' => '1' }); | |
80 | to_string({ 'tristate' => undef }); | |
6ccbcbec WB |
81 | |
82 | my $ref1 = { x => "x was stored" }; | |
83 | my $ref2 = RSPM::Foo142::test_refs({ copied => "copied string", reference => $ref1 }); | |
84 | print($ref1->{x}, "\n"); | |
85 | $ref2->{x} = "x was changed"; | |
86 | print($ref1->{x}, "\n"); | |
1521415b WB |
87 | |
88 | my $magic = RSPM::Magic->new('magic test'); | |
89 | $magic->call(); | |
90 | ||
1e46bfbe WB |
91 | sub test_unsafe_clone($) { |
92 | my ($bad) = @_; | |
93 | eval { $bad->call() }; | |
94 | if (!$@) { | |
95 | die "cloned object not properly detected!\n"; | |
96 | } elsif ($@ ne "value blessed into RSPM::Magic did not contain its declared magic pointer\n") { | |
97 | die "cloned object error message changed to: [$@]\n"; | |
98 | } | |
99 | undef $bad; | |
100 | print("unsafe dclone dropped\n"); | |
1521415b | 101 | } |
1e46bfbe WB |
102 | |
103 | print("Testing unsafe dclone\n"); | |
104 | test_unsafe_clone(Storable::dclone($magic)); | |
105 | ||
106 | print("Testing unsafe clone\n"); | |
107 | test_unsafe_clone(Clone::clone($magic)); | |
0044cdce | 108 | undef $magic; |
8932eaeb WB |
109 | |
110 | print("Testing enum deserialization\n"); | |
111 | my $ra = RSPM::Foo142::test_enums("something"); | |
112 | die "unexpected result from test_enums: $ra\n" if $ra ne 'result-a'; | |
0044cdce WB |
113 | |
114 | print("Testing optional parameters\n"); | |
115 | RSPM::Foo142::test_trailing_optional(1, 99); | |
116 | RSPM::Foo142::test_trailing_optional(2, undef); | |
117 | RSPM::Foo142::test_trailing_optional(3); | |
a43bf932 WB |
118 | |
119 | print("Substring test\n"); | |
120 | my $orig = "OneTwoThree"; | |
121 | my $sub = RSPM::Foo142::test_substr_return($orig); | |
122 | print("[$orig] [$sub]\n"); |