1 ################################################################################
3 # PPPort_pm.PL -- generate PPPort.pm
5 # Set the environment variable DPPP_CHECK_LEVEL to more than zero for some
6 # extra checking. 1 or 2 currently
8 ################################################################################
10 # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
11 # Copyright (C) 2018, The perl5 porters
12 # Version 2.x, Copyright (C) 2001, Paul Marquess.
13 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
15 # This program is free software; you can redistribute it and/or
16 # modify it under the same terms as Perl itself.
18 ################################################################################
22 require "./parts/ppptools.pl";
24 my $INCLUDE = 'parts/inc';
27 my %embed = map { ( $_->{name} => $_ ) }
28 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc));
30 my(%provides, %prototypes, %explicit);
32 my $data = do { local $/; <DATA> };
34 # Call include(file, params) for every line that begins with %include
35 $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
36 {eval "$1('$2', $3)" or die $@}gem;
38 $data = expand($data);
40 my @api = sort { lc $a cmp lc $b or $a cmp $b } keys %provides;
42 $data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
43 {join '', map "$1$_\n", @api}gem;
47 for (keys %explicit) {
48 length > $len and $len = length;
50 my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
53 $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^!
54 sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
55 $1 . '-'x$len . "\n" .
56 join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
61 my %raw_base = %{&parse_todo('parts/base')};
62 my %raw_todo = %{&parse_todo('parts/todo')};
65 for (keys %raw_todo) {
66 push @{$todo{$raw_todo{$_}}}, $_;
71 if (exists $raw_todo{$_} and exists $raw_base{$_}) {
72 if ($raw_base{$_} eq $raw_todo{$_}) {
73 warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
74 . "todo for " . format_version($raw_todo{$_}) . "\n";
77 check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
78 " (baseline revision: " . format_version($raw_base{$_}) . ").");
84 for (keys %provides) {
85 next if /^Perl_(.*)/ && exists $embed{$1};
86 next if exists $embed{$_};
88 check(2, "No API definition for provided element $_ found.");
91 push @perl_api, keys %embed;
94 if (exists $provides{$_} && !exists $raw_base{$_}) {
95 check(2, "Mmmh, $_ doesn't seem to need backporting.");
97 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
98 $line .= ($raw_todo{$_} || '') . '|';
99 $line .= 'p' if exists $provides{$_};
100 if (exists $embed{$_}) {
102 if (exists $e->{flags}{p}) { # Has 'Perl_' prefix
103 my $args = $e->{args};
104 $line .= 'v' if @$args && $args->[-1][0] eq '...';
106 $line .= 'n' if exists $e->{flags}{T}; # No thread context parameter
111 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
112 join "\n", map "$1$_", sort @perl_api
115 my $undocumented = "(undocumented)";
118 for (reverse sort keys %todo) {
119 my $ver = format_version($_);
120 my $todo = "=item perl $ver\n\n";
121 for (sort @{$todo{$_}}) {
123 $todo .= " (DEPRECATED)" if $embed{$_}->{flags}{D};
124 $todo .= " (marked experimental)" if $embed{$_}->{flags}{x};
125 $todo .= " $undocumented" unless $embed{$_}->{flags}{d};
131 $data =~ s{^__UNSUPPORTED_API__(\s*?)^}
132 {join "\n", @todo}gem;
134 $data =~ s{__MIN_PERL__}{5.003}g;
135 $data =~ s{__MAX_PERL__}{5.30}g;
137 open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
145 my($file, $opt) = @_;
147 print "including $file\n";
149 my $data = parse_partspec("$INCLUDE/$file");
151 for (@{$data->{provides}}) {
152 if (exists $provides{$_}) {
153 if ($provides{$_} ne $file) {
154 warn "$file: $_ already provided by $provides{$_}\n";
158 $provides{$_} = $file;
162 for (keys %{$data->{prototypes}}) {
163 $prototypes{$_} = $data->{prototypes}{$_};
164 $prototypes{$_} = normalize_prototype($data->{prototypes}{$_});
165 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
168 my $out = $data->{implementation};
170 if (exists $opt->{indent}) {
171 $out =~ s/^/$opt->{indent}/gm;
180 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
190 (?:[^\r\n\\]|\\[^\r\n])*
194 (?:[^\r\n\\]|\\[^\r\n])*
198 {expand_undefined($2, $1, $3)}gemx;
199 $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
200 {expand_need_var($1, $3, $2, $4)}gem;
201 $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
202 {expand_need_dummy_var($1, $3, $2, $4)}gem;
208 my($indent, $var, $type, $init) = @_;
210 $explicit{$var} = 'var';
212 my $myvar = "$DPPP(my_$var)";
213 $init = defined $init ? " = $init" : "";
215 my $code = <<ENDCODE;
216 #if defined(NEED_$var)
217 static $type $myvar$init;
218 #elif defined(NEED_${var}_GLOBAL)
226 $code =~ s/^/$indent/mg;
231 sub expand_need_dummy_var
233 my($indent, $var, $type, $init) = @_;
235 $explicit{$var} = 'var';
237 my $myvar = "$DPPP(dummy_$var)";
238 $init = defined $init ? " = $init" : "";
240 my $code = <<ENDCODE;
241 #if defined(NEED_$var)
242 static $type $myvar$init;
243 #elif defined(NEED_${var}_GLOBAL)
250 $code =~ s/^/$indent/mg;
257 my($macro, $withargs, $def) = @_;
258 my $rv = "#ifndef $macro\n# define ";
260 if (defined $def && $def =~ /\S/) {
261 $rv .= sprintf "%-30s %s", $withargs, $def;
272 sub expand_pp_expressions
275 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
283 if ($expr =~ /^\s*need\s+(\w+)\s*$/i) {
285 my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
286 my $proto = make_prototype($e);
287 if (exists $prototypes{$func}) {
288 if (compare_prototypes($proto, $prototypes{$func})) {
289 my $proto_no_pTHX = $proto;
290 $proto_no_pTHX =~ s/pTHX_\s*//;
291 if (compare_prototypes($proto_no_pTHX, $prototypes{$func})) {
292 check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
295 check(1, "prototypes differ in pTHX_ for $func:\n API: $proto\n PPP: $prototypes{$func}");
297 $proto = $prototypes{$func};
301 warn "found no prototype for $func\n";;
304 $explicit{$func} = 'func';
306 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
307 my $embed = make_embed($e);
309 return "defined(NEED_$func)\n"
316 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)\n"
321 die "cannot expand preprocessor expression '$expr'\n";
328 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
329 my $lastarg = ${$f->{args}}[-1];
331 if ($f->{flags}{T}) {
332 if ($f->{flags}{p}) {
333 return "#define $n $DPPP(my_$n)\n" .
334 "#define Perl_$n $DPPP(my_$n)";
337 return "#define $n $DPPP(my_$n)";
346 if ($f->{flags}{p}) {
347 if ($f->{flags}{f}) {
348 return "#define Perl_$n $DPPP(my_$n)";
350 elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
351 return $undef . "#define $n $DPPP(my_$n)\n" .
352 "#define Perl_$n $DPPP(my_$n)";
355 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
356 "#define Perl_$n $DPPP(my_$n)";
360 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
369 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
370 print STDERR @_, "\n";
375 ################################################################################
377 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
379 # This file was automatically generated from the definition files in the
380 # parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
381 # works, please read the F<HACKERS> file that came with this distribution.
383 ################################################################################
385 # Perl/Pollution/Portability
387 ################################################################################
389 # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
390 # Copyright (C) 2018, The perl5 porters
391 # Version 2.x, Copyright (C) 2001, Paul Marquess.
392 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
394 # This program is free software; you can redistribute it and/or
395 # modify it under the same terms as Perl itself.
397 ################################################################################
401 Devel::PPPort - Perl/Pollution/Portability
405 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
406 Devel::PPPort::WriteFile('someheader.h');
408 # Same as above but retrieve contents rather than write file
409 my $contents = Devel::PPPort::GetFileContents();
410 my $contents = Devel::PPPort::GetFileContents('someheader.h');
412 =head1 Start using Devel::PPPort for XS projects
415 $ perl -MDevel::PPPort -e'Devel::PPPort::WriteFile'
416 $ perl ppport.h --compat-version=5.6.1 --patch=diff.patch *.xs
417 $ patch -p0 < diff.patch
418 $ echo ppport.h >>MANIFEST
422 Perl's API has changed over time, gaining new features, new functions,
423 increasing its flexibility, and reducing the impact on the C namespace
424 environment (reduced pollution). The header file written by this module,
425 typically F<ppport.h>, attempts to bring some of the newer Perl API
426 features to older versions of Perl, so that you can worry less about
427 keeping track of old releases, but users can still reap the benefit.
429 C<Devel::PPPort> contains two functions, C<WriteFile> and C<GetFileContents>.
430 C<WriteFile>'s only purpose is to write the F<ppport.h> C header file.
431 This file contains a series of macros and, if explicitly requested, functions
432 that allow XS modules to be built using older versions of Perl. Currently,
433 Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
435 C<GetFileContents> can be used to retrieve the file contents rather than
438 This module is used by C<h2xs> to write the file F<ppport.h>.
440 =head2 Why use ppport.h?
442 You should use F<ppport.h> in modern code so that your code will work
443 with the widest range of Perl interpreters possible, without significant
446 You should attempt to get older code to fully use F<ppport.h>, because the
447 reduced pollution of newer Perl versions is an important thing. It's so
448 important that the old polluting ways of original Perl modules will not be
449 supported very far into the future, and your module will almost certainly
450 break! By adapting to it now, you'll gain compatibility and a sense of
451 having done the electronic ecology some good.
453 =head2 How to use ppport.h
455 Don't direct the users of your module to download C<Devel::PPPort>.
456 They are most probably not XS writers. Also, don't make F<ppport.h>
457 optional. Rather, just take the most recent copy of F<ppport.h> that
458 you can find (e.g. by generating it with the latest C<Devel::PPPort>
459 release from CPAN), copy it into your project, adjust your project to
460 use it, and distribute the header along with your module.
462 =head2 Running ppport.h
464 But F<ppport.h> is more than just a C header. It's also a Perl script
465 that can check your source code. It will suggest hints and portability
466 notes, and can even make suggestions on how to change your code. You
467 can run it like any other Perl program:
469 perl ppport.h [options] [files]
471 It also has embedded documentation, so you can use
475 to find out more about how to use it.
481 C<WriteFile> takes one optional argument. When called with one
482 argument, it expects to be passed a filename. When called with
483 no arguments, it defaults to the filename F<ppport.h>.
485 The function returns a true value if the file was written successfully.
486 Otherwise it returns a false value.
488 =head2 GetFileContents
490 C<GetFileContents> behaves like C<WriteFile> above, but returns the contents
491 of the would-be file rather than writing it out.
495 F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
496 in threaded and non-threaded configurations.
498 =head2 Provided Perl compatibility API
500 The header file written by this module, typically F<ppport.h>, provides
501 access to the following elements of the Perl API that are not otherwise
502 available in Perl releases older than when the elements were first introduced.
503 (Many of these are not supported all the way back to __MIN_PERL__;
504 see L</Perl API not supported by ppport.h back to __MIN_PERL__> for details.)
508 =head2 Perl API not supported by ppport.h back to __MIN_PERL__
510 There is still a big part of the API not fully supported by F<ppport.h>.
511 This can be because it doesn't make sense to back-port that part of the API,
512 or simply because it hasn't been implemented yet. Patches welcome! Some
513 elements are ported backward for some releases, but not all the way to
516 Below is a list of the API that isn't currently supported back to
517 __MIN_PERL__, sorted by the version of Perl below which it is unsupported.
518 Only things you should be using are included in the list, so not listed are
519 deprecated and experimental functions.
521 Some of the entries are marked as "undocumented". This means that they
522 aren't necessarily considered stable, and could be changed or removed in some
523 future release without warning. It is therefore a bad idea to use them
524 without further checking. It could be that these are considered to be for
525 perl core use only; or it could be, though, that C<Devel::PPPort> doesn't know
526 where to find their documentation, or that it's just an oversight that they
527 haven't been documented. If you want to use one, and potentially have it
528 backported, first send mail to L<mailto:perl5-porters@perl.org>.
538 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
539 system, or any of its tests fail, please send a bug report to
540 L<perlbug@perl.org|mailto:perlbug@perl.org>.
548 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
552 Version 2.x was ported to the Perl core by Paul Marquess.
556 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
560 Versions >= 3.22 are maintained by perl5 porters
566 Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
568 Copyright (C) 2018, The perl5 porters
570 Version 2.x, Copyright (C) 2001, Paul Marquess.
572 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
574 This program is free software; you can redistribute it and/or
575 modify it under the same terms as Perl itself.
579 See L<h2xs>, L<ppport.h>.
583 package Devel::PPPort;
586 use vars qw($VERSION $data);
592 $data = do { local $/; <DATA> };
593 my $pkg = 'Devel::PPPort';
594 $data =~ s/__PERL_VERSION__/$]/g;
595 $data =~ s/__VERSION__/$VERSION/g;
596 $data =~ s/__PKG__/$pkg/g;
600 sub GetFileContents {
601 my $file = shift || 'ppport.h';
602 defined $data or _init_data();
604 $copy =~ s/\bppport\.h\b/$file/g;
611 my $file = shift || 'ppport.h';
612 my $data = GetFileContents($file);
613 open F, ">$file" or return undef;
627 ----------------------------------------------------------------------
629 ppport.h -- Perl/Pollution/Portability Version __VERSION__
631 Automatically created by __PKG__ running under perl __PERL_VERSION__.
633 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
634 includes in parts/inc/ instead.
636 Use 'perldoc ppport.h' to view the documentation below.
638 ----------------------------------------------------------------------
642 %include ppphdoc { indent => '|>' }
649 #ifndef _P_P_PORTABILITY_H_
650 #define _P_P_PORTABILITY_H_
652 #ifndef DPPP_NAMESPACE
653 # define DPPP_NAMESPACE DPPP_
656 #define DPPP_CAT2(x,y) CAT2(x,y)
657 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
729 #endif /* _P_P_PORTABILITY_H_ */
731 /* End of File ppport.h */