| 1 | use ExtUtils::MakeMaker; |
| 2 | use ExtUtils::Constant 0.23 'WriteConstants'; |
| 3 | use File::Spec; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | |
| 7 | my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV; |
| 8 | |
| 9 | WriteMakefile( |
| 10 | NAME => "B", |
| 11 | VERSION_FROM => "B.pm", |
| 12 | realclean => {FILES=> 'const-c.inc const-xs.inc'}, |
| 13 | ); |
| 14 | |
| 15 | my $headerpath; |
| 16 | if ($core) { |
| 17 | $headerpath = File::Spec->catdir(File::Spec->updir, File::Spec->updir); |
| 18 | } else { |
| 19 | require Config; |
| 20 | $headerpath = File::Spec->catdir($Config::Config{archlibexp}, "CORE"); |
| 21 | } |
| 22 | |
| 23 | my @names = qw(HEf_SVKEY |
| 24 | SVTYPEMASK SVt_PVGV SVt_PVHV |
| 25 | PAD_FAKELEX_ANON PAD_FAKELEX_MULTI); |
| 26 | |
| 27 | |
| 28 | # First element in each tuple is the file; second is a regex snippet |
| 29 | # giving the prefix to limit the names of symbols to define that come |
| 30 | # from that file. If none, all symbols will be defined whose values |
| 31 | # match the pattern below. |
| 32 | foreach my $tuple (['cop.h'], |
| 33 | ['cv.h', 'CVf'], |
| 34 | ['gv.h', 'GVf'], |
| 35 | ['op.h'], |
| 36 | ['op_reg_common.h','(?:(?:RXf_)?PMf_)'], |
| 37 | ['regexp.h','RXf_'], |
| 38 | ['sv.h', 'SV(?:[fps]|pad)_'], |
| 39 | ) { |
| 40 | my $file = $tuple->[0]; |
| 41 | my $pfx = $tuple->[1] || ''; |
| 42 | my $path = File::Spec->catfile($headerpath, $file); |
| 43 | open my $fh, '<', $path or die "Cannot open $path: $!"; |
| 44 | while (<$fh>) { |
| 45 | push @names, $1 if (/ \#define \s+ ( $pfx \w+ ) \s+ |
| 46 | ( [()|\dx]+ # Parens, '|', digits, 'x' |
| 47 | | \(? \d+ \s* << .*? # digits left shifted by anything |
| 48 | ) \s* (?: $| \/ \* ) # ending at comment or $ |
| 49 | /x); |
| 50 | } |
| 51 | close $fh; |
| 52 | } |
| 53 | |
| 54 | # Currently only SVt_PVGV and SVt_PVHV aren't macros, but everything we name |
| 55 | # should exist, so ensure that the C compile breaks if anything does not. |
| 56 | WriteConstants( |
| 57 | PROXYSUBS => {push => 'EXPORT_OK'}, |
| 58 | NAME => 'B', |
| 59 | NAMES => [map {ref $_ ? $_ : {name=>$_, macro=>1}} @names], |
| 60 | XS_SUBNAME => undef, |
| 61 | ); |