1#include "EXTERN.h" 2#include "perl.h" 3#include "XSUB.h" 4 5typedef IV MyType; 6typedef IV MyType2; 7typedef IV MyType3; 8typedef IV MyType4; 9typedef IV MyType5; 10typedef IV MyType6; 11 12 13=for testing 14 15This parts are ignored. 16 17=cut 18 19/* Old perls (pre 5.8.9 or so) did not have PERL_UNUSED_ARG in XSUB.h. 20 * This is normally covered by ppport.h. */ 21#ifndef PERL_UNUSED_ARG 22# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ 23# include <note.h> 24# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) 25# else 26# define PERL_UNUSED_ARG(x) ((void)x) 27# endif 28#endif 29#ifndef PERL_UNUSED_VAR 30# define PERL_UNUSED_VAR(x) ((void)x) 31#endif 32 33/* Newx was introduced in 5.8.8, would also be in ppport.h */ 34#ifndef Newx 35# define Newx(v,n,t) New(0,v,n,t) 36#endif 37 38 39STATIC void 40outlist(int* a, int* b){ 41 *a = 'a'; 42 *b = 'b'; 43} 44 45STATIC bool 46outlist_bool(const char *a, const char *b, char **c) 47{ 48 dTHX; 49 STRLEN lena = strlen(a); 50 STRLEN lenb = strlen(b); 51 STRLEN lenc = lena + lenb; 52 Newx(*c, lenc+1, char); 53 strcpy(*c, a); 54 strcat(*c, b); 55 SAVEFREEPV(*c); 56 57 return TRUE; 58} 59 60STATIC int 61outlist_int(const char *a, const char *b, char **c) 62{ 63 dTHX; 64 STRLEN lena = strlen(a); 65 STRLEN lenb = strlen(b); 66 STRLEN lenc = lena + lenb; 67 Newx(*c, lenc+1, char); 68 strcpy(*c, a); 69 strcat(*c, b); 70 SAVEFREEPV(*c); 71 72 return 11; 73} 74 75STATIC int 76len(const char* const s, int const l){ 77 PERL_UNUSED_ARG(s); 78 return l; 79} 80 81MODULE = XSMore PACKAGE = XSMore 82 83=for testing 84 85This parts are also ignored. 86 87=cut 88 89PROTOTYPES: ENABLE 90 91VERSIONCHECK: DISABLE 92 93REQUIRE: 2.20 94 95SCOPE: DISABLE 96 97FALLBACK: TRUE 98 99BOOT: 100 sv_setiv(get_sv("XSMore::boot_ok", TRUE), 100); 101 102 103TYPEMAP: <<END 104MyType T_IV 105END 106 107TYPEMAP: <<" FOO BAR BAZ"; 108MyType2 T_FOOOO 109 110OUTPUT 111T_FOOOO 112 sv_setiv($arg, (IV)$var); 113 FOO BAR BAZ 114 115TYPEMAP: <<'END' 116MyType3 T_BAAR 117MyType4 T_BAAR 118 119OUTPUT 120T_BAAR 121 sv_setiv($arg, (IV)$var); 122 123INPUT 124T_BAAR 125 $var = ($type)SvIV($arg) 126END 127 128TYPEMAP: <<END 129MyType5 T_WITHSEMICOLON 130 131INPUT 132 133T_WITHSEMICOLON 134 $var = ($type)SvIV($arg); 135END 136 137TYPEMAP: <<SEMICOLONHERE; 138MyType6 T_IV 139SEMICOLONHERE 140 141MyType 142typemaptest1() 143 CODE: 144 RETVAL = 42; 145 OUTPUT: 146 RETVAL 147 148MyType2 149typemaptest2() 150 CODE: 151 RETVAL = 42; 152 OUTPUT: 153 RETVAL 154 155MyType3 156typemaptest3(foo, bar, baz) 157 MyType4 foo 158 MyType5 bar 159 MyType5 baz 160 CODE: 161 PERL_UNUSED_VAR(bar); 162 PERL_UNUSED_VAR(baz); 163 RETVAL = foo; 164 OUTPUT: 165 RETVAL 166 167MyType6 168typemaptest6(foo) 169 MyType6 foo 170 CODE: 171 RETVAL = foo; 172 OUTPUT: 173 RETVAL 174 175void 176prototype_ssa() 177PROTOTYPE: $$@ 178CODE: 179 NOOP; 180 181void 182attr_method(self, ...) 183ATTRS: method 184CODE: 185 NOOP; 186 187#define RET_1 1 188#define RET_2 2 189 190int 191return_1() 192CASE: ix == 1 193 ALIAS: 194 return_1 = RET_1 195 return_2 = RET_2 196 CODE: 197 RETVAL = ix; 198 OUTPUT: 199 RETVAL 200CASE: ix == 2 201 CODE: 202 RETVAL = ix; 203 OUTPUT: 204 RETVAL 205 206int 207arg_init(x) 208 int x = SvIV($arg); 209CODE: 210 RETVAL = x; 211OUTPUT: 212 RETVAL 213 214int 215myabs(...) 216OVERLOAD: abs 217CODE: 218 PERL_UNUSED_VAR(items); 219 RETVAL = 42; 220OUTPUT: 221 RETVAL 222 223void 224hook(IN AV* av) 225INIT: 226 av_push(av, newSVpv("INIT", 0)); 227CODE: 228 av_push(av, newSVpv("CODE", 0)); 229POSTCALL: 230 av_push(av, newSVpv("POSTCALL", 0)); 231CLEANUP: 232 av_push(av, newSVpv("CLEANUP", 0)); 233 234 235void 236outlist(OUTLIST int a, OUTLIST int b) 237 238bool 239outlist_bool(const char *a, const char *b, OUTLIST char *c) 240 241int 242outlist_int(const char *a, const char *b, OUTLIST char *c) 243 244int 245len(char* s, int length(s)) 246 247INCLUDE_COMMAND: $^X -Ilib -It/lib -MIncludeTester -e IncludeTester::print_xs 248 249#if 1 250 251INCLUDE: XSInclude.xsh 252 253#else 254 255# for testing #else directive 256 257#endif 258 259MODULE=XSMore PACKAGE=XSMore::More 260 261void 262dummy() 263PROTOTYPE: $$$$$ 264CODE: 265 NOOP; 266 267void 268should_not_have_prototype() 269OVERLOAD: + 270CODE: 271 NOOP; 272