File Coverage

xsubs/native.xs
Criterion Covered Total %
statement 11 11 100.0
branch 19 20 95.0
condition n/a
subroutine n/a
pod n/a
total 30 31 96.7


line stmt bran cond sub pod time code
1             ################################################################################
2             #
3             # Copyright (c) 2002-2020 Marcus Holland-Moritz. All rights reserved.
4             # This program is free software; you can redistribute it and/or modify
5             # it under the same terms as Perl itself.
6             #
7             ################################################################################
8              
9              
10             ################################################################################
11             #
12             # FUNCTION: native
13             #
14             # WRITTEN BY: Marcus Holland-Moritz ON: Aug 2004
15             # CHANGED BY: ON:
16             #
17             ################################################################################
18             #
19             # DESCRIPTION: Get property of the native platform.
20             #
21             ################################################################################
22              
23             SV *
24             native(...)
25             PREINIT:
26 93           CBC_METHOD(native);
27             int method_call;
28              
29             CODE:
30 93 100         method_call = items > 0 && sv_isobject(ST(0));
    100          
31              
32 93 100         if (items > (method_call ? 2 : 1))
    100          
33 12           Perl_croak(aTHX_ "Usage: Convert::Binary::C::native(property)");
34              
35 81 100         CHECK_VOID_CONTEXT;
    100          
    100          
36              
37 69 100         if (items == (method_call ? 1 : 0))
38             {
39 2           RETVAL = get_native_property(aTHX_ NULL);
40             }
41             else
42             {
43 67 50         const char *property = (const char *)SvPV_nolen(ST(items-1));
44              
45 67           RETVAL = get_native_property(aTHX_ property);
46              
47 67 100         if (RETVAL == NULL)
48 8           Perl_croak(aTHX_ "Invalid property '%s'", property);
49             }
50              
51             OUTPUT:
52             RETVAL
53