1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 typedef IV MyType;
6 typedef IV MyType2;
7 typedef IV MyType3;
8 typedef IV MyType4;
9 typedef IV MyType5;
10 typedef IV MyType6;
11
12
13 =for testing
14
15 This 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
39 STATIC void
40 outlist(int* a, int* b){
41 *a = 'a';
42 *b = 'b';
43 }
44
45 STATIC bool
outlist_bool(const char * a,const char * b,char ** c)46 outlist_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
60 STATIC int
outlist_int(const char * a,const char * b,char ** c)61 outlist_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
75 STATIC int
len(const char * const s,int const l)76 len(const char* const s, int const l){
77 PERL_UNUSED_ARG(s);
78 return l;
79 }
80
81 MODULE = XSMore PACKAGE = XSMore
82
83 =for testing
84
85 This parts are also ignored.
86
87 =cut
88
89 PROTOTYPES: ENABLE
90
91 VERSIONCHECK: DISABLE
92
93 REQUIRE: 2.20
94
95 SCOPE: DISABLE
96
97 FALLBACK: TRUE
98
99 BOOT:
100 sv_setiv(get_sv("XSMore::boot_ok", TRUE), 100);
101
102
103 TYPEMAP: <<END
104 MyType T_IV
105 END
106
107 TYPEMAP: <<" FOO BAR BAZ";
108 MyType2 T_FOOOO
109
110 OUTPUT
111 T_FOOOO
112 sv_setiv($arg, (IV)$var);
113 FOO BAR BAZ
114
115 TYPEMAP: <<'END'
116 MyType3 T_BAAR
117 MyType4 T_BAAR
118
119 OUTPUT
120 T_BAAR
121 sv_setiv($arg, (IV)$var);
122
123 INPUT
124 T_BAAR
125 $var = ($type)SvIV($arg)
126 END
127
128 TYPEMAP: <<END
129 MyType5 T_WITHSEMICOLON
130
131 INPUT
132
133 T_WITHSEMICOLON
134 $var = ($type)SvIV($arg);
135 END
136
137 TYPEMAP: <<SEMICOLONHERE;
138 MyType6 T_IV
139 SEMICOLONHERE
140
141 MyType
142 typemaptest1()
143 CODE:
144 RETVAL = 42;
145 OUTPUT:
146 RETVAL
147
148 MyType2
149 typemaptest2()
150 CODE:
151 RETVAL = 42;
152 OUTPUT:
153 RETVAL
154
155 MyType3
156 typemaptest3(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
167 MyType6
168 typemaptest6(foo)
169 MyType6 foo
170 CODE:
171 RETVAL = foo;
172 OUTPUT:
173 RETVAL
174
175 void
176 prototype_ssa()
177 PROTOTYPE: $$@
178 CODE:
179 NOOP;
180
181 void
182 attr_method(self, ...)
183 ATTRS: method
184 CODE:
185 NOOP;
186
187 #define RET_1 1
188 #define RET_2 2
189
190 int
191 return_1()
192 CASE: ix == 1
193 ALIAS:
194 return_1 = RET_1
195 return_2 = RET_2
196 CODE:
197 RETVAL = ix;
198 OUTPUT:
199 RETVAL
200 CASE: ix == 2
201 CODE:
202 RETVAL = ix;
203 OUTPUT:
204 RETVAL
205
206 int
207 arg_init(x)
208 int x = SvIV($arg);
209 CODE:
210 RETVAL = x;
211 OUTPUT:
212 RETVAL
213
214 int
215 myabs(...)
216 OVERLOAD: abs
217 CODE:
218 PERL_UNUSED_VAR(items);
219 RETVAL = 42;
220 OUTPUT:
221 RETVAL
222
223 void
224 hook(IN AV* av)
225 INIT:
226 av_push(av, newSVpv("INIT", 0));
227 CODE:
228 av_push(av, newSVpv("CODE", 0));
229 POSTCALL:
230 av_push(av, newSVpv("POSTCALL", 0));
231 CLEANUP:
232 av_push(av, newSVpv("CLEANUP", 0));
233
234
235 void
236 outlist(OUTLIST int a, OUTLIST int b)
237
238 bool
239 outlist_bool(const char *a, const char *b, OUTLIST char *c)
240
241 int
242 outlist_int(const char *a, const char *b, OUTLIST char *c)
243
244 int
245 len(char* s, int length(s))
246
247 INCLUDE_COMMAND: $^X -Ilib -It/lib -MIncludeTester -e IncludeTester::print_xs
248
249 #if 1
250
251 INCLUDE: XSInclude.xsh
252
253 #else
254
255 # for testing #else directive
256
257 #endif
258
259 MODULE=XSMore PACKAGE=XSMore::More
260
261 void
262 dummy()
263 PROTOTYPE: $$$$$
264 CODE:
265 NOOP;
266
267 void
268 should_not_have_prototype()
269 OVERLOAD: +
270 CODE:
271 NOOP;
272