This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.06.
[perl5.git] / ext / Devel / PPPort / PPPort_pm.PL
CommitLineData
adfe19db
MHM
1################################################################################
2#
3# PPPort_pm.PL -- generate PPPort.pm
4#
5################################################################################
6#
9132e1a3 7# $Revision: 33 $
adfe19db 8# $Author: mhx $
9132e1a3 9# $Date: 2005/01/31 08:10:55 +0100 $
adfe19db
MHM
10#
11################################################################################
12#
9132e1a3 13# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
adfe19db
MHM
14# Version 2.x, Copyright (C) 2001, Paul Marquess.
15# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
16#
17# This program is free software; you can redistribute it and/or
18# modify it under the same terms as Perl itself.
19#
20################################################################################
21
22use strict;
23$^W = 1;
24require "parts/ppptools.pl";
25
26my $INCLUDE = 'parts/inc';
27my $DPPP = 'DPPP_';
28
29my %embed = map { ( $_->{name} => $_ ) }
30 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc));
31
32my(%provides, %prototypes, %explicit);
33
34my $data = do { local $/; <DATA> };
35$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
36 {eval "$1('$2', $3)" or die $@}gem;
37
38$data = expand($data);
39
40my @api = sort { lc $a cmp lc $b } keys %provides;
41
42$data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
43 {join '', map "$1$_\n", @api}gem;
44
45{
46 my $len = 0;
47 for (keys %explicit) {
48 length > $len and $len = length;
49 }
50 my $format = sprintf "%%-%ds %%-%ds %%-%ds", $len+2, $len+5, $len+12;
51 $len = 3*$len + 23;
52
53$data =~ s/^(.*)__EXPLICIT_API__(\s*?)^/
54 sprintf("$1$format\n", 'Function', 'Static Request', 'Global Request') .
55 $1 . '-'x$len . "\n" .
56 join('', map { sprintf "$1$format\n", "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
57 sort keys %explicit)
58 /gem;
59}
60
61my %raw_base = %{&parse_todo('parts/base')};
62my %raw_todo = %{&parse_todo('parts/todo')};
63
64my %todo;
65for (keys %raw_todo) {
66 push @{$todo{$raw_todo{$_}}}, $_;
67}
68
69# check consistency
70for (@api) {
71 if (exists $raw_todo{$_}) {
96ad942f
MHM
72 if ($raw_base{$_} eq $raw_todo{$_}) {
73 warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
74 . "todo for " . format_version($raw_todo{$_}) . "\n";
75 }
76 else {
77 check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
78 " (baseline revision: " . format_version($raw_base{$_}) . ").");
79 }
adfe19db
MHM
80 }
81}
82
83my @perl_api;
84for (keys %provides) {
85 next if exists $embed{$_};
86 push @perl_api, $_;
87 check(2, "No API definition for provided element $_ found.");
88}
89
90push @perl_api, keys %embed;
91
92for (@perl_api) {
93 if (exists $provides{$_} && !exists $raw_base{$_}) {
94 check(2, "Mmmh, $_ doesn't seem to need backporting.");
95 }
96 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
97 $line .= ($raw_todo{$_} || '') . '|';
98 $line .= 'p' if exists $provides{$_};
99 if (exists $embed{$_}) {
100 my $e = $embed{$_};
101 if (exists $e->{flags}{p}) {
102 my $args = $e->{args};
103 $line .= 'v' if @$args && $args->[-1][0] eq '...';
104 }
105 $line .= 'n' if exists $e->{flags}{n};
106 }
107 $_ = $line;
108}
109
110$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
111 join "\n", map "$1$_", sort @perl_api
112 /gem;
113
114my @todo;
115for (reverse sort keys %todo) {
116 my $ver = format_version($_);
117 my $todo = "=item perl $ver\n\n";
118 for (sort @{$todo{$_}}) {
119 $todo .= " $_\n";
120 }
121 push @todo, $todo;
122}
123
124$data =~ s{^__UNSUPPORTED_API__(\s*?)^}
125 {join "\n", @todo}gem;
126
127$data =~ s{__MIN_PERL__}{5.003}g;
128$data =~ s{__MAX_PERL__}{5.9.2}g;
129
130open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
131print FH $data;
132close FH;
133
134exit 0;
135
136sub include
137{
138 my($file, $opt) = @_;
139
140 print "including $file\n";
141
142 my $data = parse_partspec("$INCLUDE/$file");
143
144 for (@{$data->{provides}}) {
145 if (exists $provides{$_}) {
146 if ($provides{$_} ne $file) {
147 warn "$file: $_ already provided by $provides{$_}\n";
148 }
149 }
150 else {
151 $provides{$_} = $file;
152 }
153 }
154
155 for (keys %{$data->{prototypes}}) {
156 $prototypes{$_} = $data->{prototypes}{$_};
96ad942f 157 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
adfe19db
MHM
158 }
159
160 my $out = $data->{implementation};
161
162 if (exists $opt->{indent}) {
163 $out =~ s/^/$opt->{indent}/gm;
164 }
165
166 return $out;
167}
168
169sub expand
170{
171 my $code = shift;
172 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
173 $code =~ s{^\s*
174 __UNDEFINED__
175 \s+
176 (
177 ( \w+ )
178 (?: \( [^)]* \) )?
179 )
180 [^\r\n\S]*
181 (
182 (?:[^\r\n\\]|\\[^\r\n])*
183 (?:
184 \\
185 (?:\r\n|[\r\n])
186 (?:[^\r\n\\]|\\[^\r\n])*
187 )*
188 )
189 \s*$}
190 {expand_undefined($2, $1, $3)}gemx;
191 return $code;
192}
193
194sub expand_undefined
195{
196 my($macro, $withargs, $def) = @_;
197 my $rv = "#ifndef $macro\n# define ";
198
199 if (defined $def) {
200 $rv .= sprintf "%-30s %s", $withargs, $def;
201 }
202 else {
203 $rv .= $withargs;
204 }
205
206 $rv .= "\n#endif\n";
207
208 return $rv;
209}
210
211sub expand_pp_expressions
212{
213 my $pp = shift;
214 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
215 return $pp;
216}
217
218sub expand_pp_expr
219{
220 my $expr = shift;
221
adfe19db
MHM
222 if ($expr =~ /^\s*need\s*(\w+)\s*$/i) {
223 my $func = $1;
224 my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
225 my $proto = make_prototype($e);
226 if (exists $prototypes{$func}) {
227 if (compare_prototypes($proto, $prototypes{$func})) {
228 check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
229 $proto = $prototypes{$func};
230 }
231 }
232 else {
233 warn "found no prototype for $func\n";;
234 }
235
236 $explicit{$func} = 1;
237
96ad942f 238 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
adfe19db
MHM
239 my $embed = make_embed($e);
240
241 return "defined(NEED_$func)\n"
242 . "static $proto;\n"
243 . "static\n"
244 . "#else\n"
245 . "extern $proto;\n"
246 . "#endif\n"
247 . "\n"
248 . "$embed\n"
249 . "\n"
96ad942f 250 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
adfe19db
MHM
251 }
252
adfe19db
MHM
253 die "cannot expand preprocessor expression '$expr'\n";
254}
255
256sub make_embed
257{
258 my $f = shift;
259 my $n = $f->{name};
260 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
261
262 if ($f->{flags}{n}) {
263 if ($f->{flags}{p}) {
96ad942f
MHM
264 return "#define $n $DPPP(my_$n)\n" .
265 "#define Perl_$n $DPPP(my_$n)";
adfe19db
MHM
266 }
267 else {
96ad942f 268 return "#define $n $DPPP(my_$n)";
adfe19db
MHM
269 }
270 }
271 else {
272 my $undef = <<UNDEF;
273#ifdef $n
274# undef $n
275#endif
276UNDEF
277 if ($f->{flags}{p}) {
96ad942f
MHM
278 if ($f->{flags}{f}) {
279 return "#define Perl_$n $DPPP(my_$n)";
280 }
281 else {
282 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
283 "#define Perl_$n $DPPP(my_$n)";
284 }
adfe19db
MHM
285 }
286 else {
96ad942f 287 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
adfe19db
MHM
288 }
289 }
290}
291
292sub check
293{
294 my $level = shift;
295
296 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
297 print STDERR @_, "\n";
298 }
299}
300
301__DATA__
302################################################################################
303#
304# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
305#
306################################################################################
307#
308# Perl/Pollution/Portability
309#
310################################################################################
311#
9132e1a3 312# $Revision: 33 $
adfe19db 313# $Author: mhx $
9132e1a3 314# $Date: 2005/01/31 08:10:55 +0100 $
adfe19db
MHM
315#
316################################################################################
317#
9132e1a3 318# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
adfe19db
MHM
319# Version 2.x, Copyright (C) 2001, Paul Marquess.
320# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
321#
322# This program is free software; you can redistribute it and/or
323# modify it under the same terms as Perl itself.
324#
325################################################################################
326
327=head1 NAME
328
329Devel::PPPort - Perl/Pollution/Portability
330
331=head1 SYNOPSIS
332
333 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
334 Devel::PPPort::WriteFile('someheader.h');
335
336=head1 DESCRIPTION
337
338Perl's API has changed over time, gaining new features, new functions,
339increasing its flexibility, and reducing the impact on the C namespace
340environment (reduced pollution). The header file written by this module,
341typically F<ppport.h>, attempts to bring some of the newer Perl API
342features to older versions of Perl, so that you can worry less about
343keeping track of old releases, but users can still reap the benefit.
344
345C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
346only purpose is to write the F<ppport.h> C header file. This file
347contains a series of macros and, if explicitly requested, functions that
348allow XS modules to be built using older versions of Perl. Currently,
349Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
350
351This module is used by C<h2xs> to write the file F<ppport.h>.
352
353=head2 Why use ppport.h?
354
355You should use F<ppport.h> in modern code so that your code will work
356with the widest range of Perl interpreters possible, without significant
357additional work.
358
359You should attempt older code to fully use F<ppport.h>, because the
360reduced pollution of newer Perl versions is an important thing. It's so
361important that the old polluting ways of original Perl modules will not be
362supported very far into the future, and your module will almost certainly
363break! By adapting to it now, you'll gain compatibility and a sense of
364having done the electronic ecology some good.
365
366=head2 How to use ppport.h
367
368Don't direct the users of your module to download C<Devel::PPPort>.
369They are most probably no XS writers. Also, don't make F<ppport.h>
370optional. Rather, just take the most recent copy of F<ppport.h> that
371you can find (e.g. by generating it with the latest C<Devel::PPPort>
372release from CPAN), copy it into your project, adjust your project to
373use it, and distribute the header along with your module.
374
375=head2 Running ppport.h
376
377But F<ppport.h> is more than just a C header. It's also a Perl script
378that can check your source code. It will suggest hints and portability
379notes, and can even make suggestions on how to change your code. You
380can run it like any other Perl program:
381
9132e1a3 382 perl ppport.h [options] [files]
adfe19db
MHM
383
384It also has embedded documentation, so you can use
385
386 perldoc ppport.h
387
388to find out more about how to use it.
389
390=head1 FUNCTIONS
391
392=head2 WriteFile
393
394C<WriteFile> takes one optional argument. When called with one
395argument, it expects to be passed a filename. When called with
396no arguments, it defaults to the filename F<ppport.h>.
397
398The function returns a true value if the file was written successfully.
399Otherwise it returns a false value.
400
401=head1 COMPATIBILITY
402
403F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
404in threaded and non-threaded configurations.
405
406=head2 Provided Perl compatibility API
407
408The header file written by this module, typically F<ppport.h>, provides
409access to the following elements of the Perl API that is not available
410in older Perl releases:
411
412 __PROVIDED_API__
413
414=head2 Perl API not supported by ppport.h
415
416There is still a big part of the API not supported by F<ppport.h>.
417Either because it doesn't make sense to back-port that part of the API,
418or simply because it hasn't been implemented yet. Patches welcome!
419
420Here's a list of the currently unsupported API, and also the version of
421Perl below which it is unsupported:
422
423=over 4
424
425__UNSUPPORTED_API__
426
427=back
428
429=head1 BUGS
430
431If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
432system or any of its tests fail, please use the CPAN Request Tracker
433at L<http://rt.cpan.org/> to create a ticket for the module.
434
435=head1 AUTHORS
436
437=over 2
438
439=item *
440
441Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
442
443=item *
444
445Version 2.x was ported to the Perl core by Paul Marquess.
446
447=item *
448
449Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
450
451=back
452
453=head1 COPYRIGHT
454
9132e1a3 455Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
adfe19db
MHM
456
457Version 2.x, Copyright (C) 2001, Paul Marquess.
458
459Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
460
461This program is free software; you can redistribute it and/or
462modify it under the same terms as Perl itself.
463
464=head1 SEE ALSO
465
466See L<h2xs>, L<ppport.h>.
467
468=cut
469
470package Devel::PPPort;
471
472require DynaLoader;
473use strict;
474use vars qw($VERSION @ISA $data);
475
2dd69576 476$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
adfe19db
MHM
477
478@ISA = qw(DynaLoader);
479
480bootstrap Devel::PPPort;
481
482{
483 $data = do { local $/; <DATA> };
484 my $now = localtime;
485 my $pkg = 'Devel::PPPort';
486 $data =~ s/__PERL_VERSION__/$]/g;
487 $data =~ s/__VERSION__/$VERSION/g;
488 $data =~ s/__DATE__/$now/g;
489 $data =~ s/__PKG__/$pkg/g;
490 $data =~ s/^POD\s//gm;
491}
492
493sub WriteFile
494{
495 my $file = shift || 'ppport.h';
496 my $copy = $data;
497 $copy =~ s/\bppport\.h\b/$file/g;
498
499 open F, ">$file" or return undef;
500 print F $copy;
501 close F;
502
503 return 1;
504}
505
5061;
507
508__DATA__
509#if 0
510<<'SKIP';
511#endif
512/*
513----------------------------------------------------------------------
514
515 ppport.h -- Perl/Pollution/Portability Version __VERSION__
516
517 Automatically created by __PKG__ running under
518 perl __PERL_VERSION__ on __DATE__.
519
520 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
521 includes in parts/inc/ instead.
522
523 Use 'perldoc ppport.h' to view the documentation below.
524
525----------------------------------------------------------------------
526
527SKIP
528
529%include ppphdoc { indent => 'POD ' }
530
531%include ppphbin
532
533__DATA__
534*/
535
536#ifndef _P_P_PORTABILITY_H_
537#define _P_P_PORTABILITY_H_
538
539#ifndef DPPP_NAMESPACE
540# define DPPP_NAMESPACE DPPP_
541#endif
542
543#define DPPP_CAT2(x,y) CAT2(x,y)
544#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
545
546%include version
547
548%include limits
549
550%include uv
551
552%include misc
553
554%include threads
555
556%include mPUSH
557
558%include call
559
560%include newRV
561
562%include newCONSTSUB
563
564%include MY_CXT
565
566%include format
567
568%include SvPV
569
96ad942f
MHM
570%include sv_xpvf
571
adfe19db
MHM
572%include magic
573
574%include cop
575
576%include grok
577
9132e1a3
MHM
578%include exception
579
adfe19db
MHM
580#endif /* _P_P_PORTABILITY_H_ */
581
582/* End of File ppport.h */