typedef short shortOPQ; /* T_OPAQUE */
typedef int intOpq; /* T_OPAQUEPTR */
+/* A structure to test T_OPAQUEPTR */
+struct t_opaqueptr {
+ int a;
+ int b;
+ double c;
+};
+
+typedef struct t_opaqueptr astruct;
+
/* Some static memory for the tests */
I32 anint;
intRef anintref;
=item T_OPAQUEPTR
-This can be used to store a pointer in the string component of the
-SV. Unlike T_PTR which stores the pointer in an IV that can be
-printed, here the representation of the pointer is irrelevant and the
-bytes themselves are just stored in the SV. If the pointer is
-represented by 4 bytes then those 4 bytes are stored in the SV (and
-length() will report a value of 4). This makes use of the fact that a
-perl scalar can store arbritray data in its PV component.
+This can be used to store bytes in the string component of the
+SV. Here the representation of the data is irrelevant to perl and the
+bytes themselves are just stored in the SV. It is assumed that the C
+variable is a pointer (the bytes are copied from that memory
+location). If the pointer is pointing to something that is
+represented by 8 bytes then those 8 bytes are stored in the SV (and
+length() will report a value of 8). This entry is similar to T_OPAQUE.
+
+In principal the unpack() command can be used to convert the bytes
+back to a number (if the underlying type is known to be a number).
-In principal the unpack() command can be used to convert the pointer
-to a number.
+This entry can be used to store a C structure (the number
+of bytes to be copied is calculated using the C C<sizeof> function)
+and can be used as an alternative to T_PTRREF without having to worry
+about a memory leak (since Perl will clean up the SV).
=cut
OUTPUT:
RETVAL
+# Test it with a structure
+astruct *
+T_OPAQUEPTR_IN_struct( a,b,c )
+ int a
+ int b
+ double c
+ PREINIT:
+ struct t_opaqueptr test;
+ CODE:
+ test.a = a;
+ test.b = b;
+ test.c = c;
+ RETVAL = &test;
+ OUTPUT:
+ RETVAL
+
+void
+T_OPAQUEPTR_OUT_struct( test )
+ astruct * test
+ PPCODE:
+ XPUSHs(sv_2mortal(newSViv(test->a)));
+ XPUSHs(sv_2mortal(newSViv(test->b)));
+ XPUSHs(sv_2mortal(newSVnv(test->c)));
+
+
=item T_OPAQUE
-This can be used to store pointers to non-pointer types in an SV. It
-is similar to T_OPAQUEPTR except that the typemap retrieves the
-pointer itself rather than assuming that it is to be given a
-pointer. This approach hides the pointer as a byte stream in the
-string part of the SV rather than making the actual pointer value
-available to Perl.
+This can be used to store data from non-pointer types in the string
+part of an SV. It is similar to T_OPAQUEPTR except that the
+typemap retrieves the pointer directly rather than assuming it
+is being supplied. For example if an integer is imported into
+Perl using T_OPAQUE rather than T_IV the underlying bytes representing the integer will be stored in the SV but the actual integer value will not be
+available. i.e. The data is opaque to perl.
+
+The data may be retrieved using the C<unpack> function if the
+underlying type of the byte stream is known.
-There is no reason to use T_OPAQUE to pass the data to C. Use
-T_OPAQUEPTR to do that since once the pointer is stored in the SV
-T_OPAQUE and T_OPAQUEPTR are identical.
+T_OPAQUE supports input and output of simple types.
+T_OPAQUEPTR can be used to pass these bytes back into C if a pointer
+is acceptable.
=cut
OUTPUT:
RETVAL
+IV
+T_OPAQUE_OUT( val )
+ shortOPQ val
+ CODE:
+ RETVAL = (IV)val;
+ OUTPUT:
+ RETVAL
+
=item Implicit array
xsubpp supports a special syntax for returning
ssize_t T_IV
time_t T_NV
unsigned long * T_OPAQUEPTR
-char ** T_PACKED
+char ** T_PACKEDARRAY
void * T_PTR
Time_t * T_PV
SV * T_SV
else
Perl_croak(aTHX_ \"$var is not a reference\")
T_REF_IV_REF
- if (sv_isa($arg, \"${type}\")) {
+ if (sv_isa($arg, \"${ntype}\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = *INT2PTR($type *, tmp);
}
else
Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
T_OPAQUE
- $var NOT IMPLEMENTED
+ $var = *($type *)SvPV($arg,PL_na)
T_OPAQUEPTR
$var = ($type)SvPV($arg,PL_na)
T_PACKED
}
use Test;
-BEGIN { plan tests => 78 }
+BEGIN { plan tests => 84 }
use strict;
use warnings;
print "# T_OPAQUEPTR\n";
$t = 22;
-$ptr = T_OPAQUEPTR_IN( $t );
-ok( T_OPAQUEPTR_OUT($ptr), $t);
+my $p = T_OPAQUEPTR_IN( $t );
+ok( T_OPAQUEPTR_OUT($p), $t);
+
+# T_OPAQUEPTR with a struct
+print "# T_OPAQUEPTR with a struct\n";
+
+my @test = (5,6,7);
+$p = T_OPAQUEPTR_IN_struct(@test);
+my @result = T_OPAQUEPTR_OUT_struct($p);
+ok(scalar(@result),scalar(@test));
+for (0..$#test) {
+ ok($result[$_], $test[$_]);
+}
# T_OPAQUE
print "# T_OPAQUE\n";
$t = 48;
-$ptr = T_OPAQUE_IN( $t );
-ok(T_OPAQUEPTR_OUT_short( $ptr ), $t);
+$p = T_OPAQUE_IN( $t );
+ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
+ok(T_OPAQUE_OUT( $p ), $t ); # Test using T_OPQAQUE
# T_OPAQUE_array
+print "# A packed array\n";
+
my @opq = (2,4,8);
my $packed = T_OPAQUE_array(@opq);
my @uopq = unpack("i*",$packed);
+ok(scalar(@uopq), scalar(@opq));
for (0..$#opq) {
ok( $uopq[$_], $opq[$_]);
}
projects / platform / upstream / perl.git / commitdiff