Use inlineable proxy constant subs for POSIX.

There may be trouble ahead, as it seems that not all POSIX "constants"
are. I wonder if too many systems are going to have too many
variations to make this viable.

p4raw-id: //depot/perl@26455

diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL
index 8630f2d..8c871c1 100644 (file)
--- a/ext/POSIX/Makefile.PL
+++ b/ext/POSIX/Makefile.PL
@@ -38,7 +38,7 @@ my @names =
       F_WRLCK HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR INLCR INPCK
       INT_MAX INT_MIN ISIG ISTRIP IXOFF IXON LC_ALL LC_COLLATE LC_CTYPE
       LC_MESSAGES LC_MONETARY LC_NUMERIC LC_TIME LINK_MAX LONG_MAX LONG_MIN
-      L_ctermid L_cuserid L_tmpnam MAX_CANON MAX_INPUT MB_CUR_MAX MB_LEN_MAX
+      L_ctermid L_cuserid L_tmpnam MAX_CANON MAX_INPUT MB_LEN_MAX
       NAME_MAX NCCS NGROUPS_MAX NOFLSH OPEN_MAX OPOST O_ACCMODE O_APPEND
       O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY
       PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX
@@ -57,6 +57,7 @@ my @names =
       _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX
       _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX
       _SC_VERSION),
+   {name=>"MB_CUR_MAX", not_constant=>1},
    {name=>"EXIT_FAILURE", default=>["IV", "1"]},
    {name=>"EXIT_SUCCESS", default=>["IV", "0"]},
    {name=>"SIG_DFL", value=>"(IV)SIG_DFL"},
@@ -67,6 +68,7 @@ my @names =
    {name=>"NULL", value=>"0"},
    {name=>"_POSIX_JOB_CONTROL", type=>"YES", default=>["IV", "0"]},
    {name=>"_POSIX_SAVED_IDS", type=>"YES", default=>["IV", "0"]},
+   {name=>'FLT_ROUNDS', type=>"NV", not_constant=>1},
    {name=>"HUGE_VAL", type=>"NV",
     macro=>[<<'END', "#endif\n"],
 #if (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)) || defined(HUGE_VAL)
@@ -89,7 +91,6 @@ push @names, {name=>$_, type=>"NV"}
               DBL_MAX_EXP DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
               FLT_DIG FLT_EPSILON FLT_MANT_DIG FLT_MAX FLT_MAX_10_EXP
               FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX
-              FLT_ROUNDS
               LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX LDBL_MAX_10_EXP
               LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP));
 
@@ -102,6 +103,7 @@ push @names, {name=>$_, type=>"IV", default=>["IV", "0"]}
              ));
 
 WriteConstants(
+    PROXYSUBS => 1,
     NAME => 'POSIX',
     NAMES => \@names,
 );

diff --git a/lib/ExtUtils/Constant/Base.pm b/lib/ExtUtils/Constant/Base.pm
index e188075..69dde25 100644 (file)
--- a/lib/ExtUtils/Constant/Base.pm
+++ b/lib/ExtUtils/Constant/Base.pm
@@ -682,7 +682,8 @@ sub normalise_items
         $item->{macro} = $macro if defined $macro;
         undef $value if defined $value and $value eq $name;
         $item->{value} = $value if defined $value;
-        foreach my $key (qw(default pre post def_pre def_post weight)) {
+        foreach my $key (qw(default pre post def_pre def_post weight
+                           not_constant)) {
           my $value = $orig->{$key};
           $item->{$key} = $value if defined $value;
           # warn "$key $value";

diff --git a/lib/ExtUtils/Constant/ProxySubs.pm b/lib/ExtUtils/Constant/ProxySubs.pm
index 9578db3..95b5e59 100644 (file)
--- a/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/lib/ExtUtils/Constant/ProxySubs.pm
@@ -1,8 +1,8 @@
 package ExtUtils::Constant::ProxySubs;
 
 use strict;
-use vars qw($VERSION @ISA %type_to_struct %type_to_sv %type_to_C_value
-           %type_is_a_problem %type_num_args);
+use vars qw($VERSION @ISA %type_to_struct %type_from_struct %type_to_sv
+           %type_to_C_value %type_is_a_problem %type_num_args);
 use Carp;
 require ExtUtils::Constant::XS;
 use ExtUtils::Constant::Utils qw(C_stringify);
@@ -14,27 +14,53 @@ $VERSION = '0.01';
 %type_to_struct =
     (
      IV => '{const char *name; I32 namelen; IV value;}',
+     NV => '{const char *name; I32 namelen; NV value;}',
+     UV => '{const char *name; I32 namelen; UV value;}',
+     YES => '{const char *name; I32 namelen;}',
+     NO => '{const char *name; I32 namelen;}',
      '' => '{const char *name; I32 namelen;} ',
      );
 
+%type_from_struct =
+    (
+     IV => sub { $_[0] . '->value' },
+     NV => sub { $_[0] . '->value' },
+     UV => sub { $_[0] . '->value' },
+     YES => sub {},
+     NO => sub {},
+     '' => sub {},
+    );
+
 %type_to_sv = 
     (
-     IV => sub { 'newSViv(' . $_[0] . '->value)' },
+     IV => sub { "newSViv($_[0])" },
+     NV => sub { "newSVnv($_[0])" },
+     UV => sub { "newSVuv($_[0])" },
+     YES => sub { '&PL_sv_yes' },
+     NO => sub { '&PL_sv_no' },
      '' => sub { '&PL_sv_yes' },
      );
 
 %type_to_C_value = 
     (
+     YES => sub {},
+     NO => sub {},
      '' => sub {},
      );
 
+sub type_to_C_value {
+    my ($self, $type) = @_;
+    return $type_to_C_value{$type} || sub {return map {ref $_ ? @$_ : $_} @_};
+}
+
 %type_is_a_problem =
     (
      SV => 1,
      );
 
 while (my ($type, $value) = each %XS_TypeSet) {
-    $type_num_args{$type} = ref $value ? scalar @$value : 1;
+    $type_num_args{$type}
+       = defined $value ? ref $value ? scalar @$value : 1 : 0;
 }
 $type_num_args{''} = 0;
 
@@ -61,7 +87,8 @@ sub partition_names {
                or !$self->macro_to_ifdef($self->macro_from_name($item));
        }
 
-       if ($item->{pre} or $item->{post} or $type_is_a_problem{$item->{type}}) {
+       if ($item->{pre} or $item->{post} or $item->{not_constant}
+           or $type_is_a_problem{$item->{type}}) {
            push @trouble, $item;
        } else {
            push @{$found{$item->{type}}}, $item;
@@ -73,13 +100,16 @@ sub partition_names {
 
 sub boottime_iterator {
     my ($self, $type, $iterator, $hash, $subname) = @_;
+    my $extractor = $type_from_struct{$type};
+    die "Can't find extractor code for type $type"
+       unless defined $extractor;
     my $generator = $type_to_sv{$type};
     die "Can't find generator code for type $type"
        unless defined $generator;
 
     my $athx = $self->C_constant_prefix_param();
 
-    return sprintf <<"EOBOOT", &$generator($iterator);
+    return sprintf <<"EOBOOT", &$generator(&$extractor($iterator));
         while ($iterator->name) {
            $subname($athx $hash, $iterator->name,
                                $iterator->namelen, %s);
@@ -88,6 +118,24 @@ sub boottime_iterator {
 EOBOOT
 }
 
+sub name_len_value_macro {
+    my ($self, $item) = @_;
+    my $name = $item->{name};
+    my $value = $item->{value};
+    $value = $item->{name} unless defined $value;
+
+    my $namelen = length $name;
+    if ($name =~ tr/\0-\377// != $namelen) {
+       # the hash API signals UTF-8 by passing the length negated.
+       utf8::encode($name);
+       $namelen = -length $name;
+    }
+    $name = C_stringify($name);
+
+    my $macro = $self->macro_from_name($item);
+    ($name, $namelen, $value, $macro);
+}
+
 sub WriteConstants {
     my $self = shift;
     my $ARGS = shift;
@@ -114,18 +162,16 @@ sub WriteConstants {
     my ($found, $notfound, $trouble)
        = $self->partition_names($default_type, @items);
 
-    die "Can't cope with trouble yet" if @$trouble;
-
     my $pthx = $self->C_constant_prefix_param_defintion();
     my $athx = $self->C_constant_prefix_param();
     my $symbol_table = C_stringify($package) . '::';
 
-    print $c_fh <<"EOADD";
+    print $c_fh $self->header(), <<"EOADD";
 void ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) {
     SV *rv = newRV_noinc(value);
     if (!hv_store(hash, name, namelen, rv, TRUE)) {
        SvREFCNT_dec(rv);
-       Perl_croak("Couldn't add key '%s' to %%%s", name, "$package");
+       Perl_croak($athx "Couldn't add key '%s' to %%%s::", name, "$package");
     }
 }
 
@@ -149,8 +195,7 @@ EOBOOT
 
     foreach my $type (sort keys %$found) {
        my $struct = $type_to_struct{$type};
-       my $type_to_value = $type_to_C_value{$type}
-           || sub {return map {ref $_ ? @$_ : $_} @_};
+       my $type_to_value = $self->type_to_C_value($type);
        my $number_of_args = $type_num_args{$type};
        die "Can't find structure definition for type $type"
            unless defined $struct;
@@ -167,19 +212,9 @@ EOBOOT
 
 
        foreach my $item (@{$found->{$type}}) {
-           my $name = $item->{name};
-           my $value = $item->{value};
-           $value = $item->{name} unless defined $value;
-
-           my $namelen = length $name;
-           if ($name =~ tr/\0-\377// != $namelen) {
-               # the hash API signals UTF-8 by passing the length negated.
-               utf8::encode($name);
-               $namelen = -length $name;
-           }
-           $name = C_stringify($name);
+            my ($name, $namelen, $value, $macro)
+                 = $self->name_len_value_macro($item);
 
-           my $macro = $self->macro_from_name($item);
            my $ifdef = $self->macro_to_ifdef($macro);
            if (!$ifdef && $item->{invert_macro}) {
                carp("Attempting to supply a default for '$name' which has no conditional macro");
@@ -220,14 +255,39 @@ EOBOOT
        while (value_for_notfound->name) {
            if (!hv_store(${c_subname}_missing, value_for_notfound->name,
                          value_for_notfound->namelen, &PL_sv_yes, TRUE))
-               Perl_croak("Couldn't add key '%s' to missing_hash",
+               Perl_croak($athx "Couldn't add key '%s' to missing_hash",
                           value_for_notfound->name);
            ++value_for_notfound;
        }
-  }
 EOBOOT
 
-   print $xs_fh <<EOCONSTANT
+    foreach my $item (@$trouble) {
+        my ($name, $namelen, $value, $macro)
+           = $self->name_len_value_macro($item);
+        my $ifdef = $self->macro_to_ifdef($macro);
+        my $type = $item->{type};
+       my $type_to_value = $self->type_to_C_value($type);
+
+        print $xs_fh $ifdef;
+       if ($item->{invert_macro}) {
+           print $xs_fh
+                "        /* This is the default value: */\n" if $type;
+           print $xs_fh "#else\n";
+       }
+       my $generator = $type_to_sv{$type};
+       die "Can't find generator code for type $type"
+           unless defined $generator;
+
+       printf $xs_fh <<"EOBOOT", $name, &$generator(&$type_to_value($value));
+       ${c_subname}_add_symbol($athx symbol_table, "%s",
+                               $namelen, %s);
+EOBOOT
+
+        print $xs_fh $self->macro_to_endif($macro);
+    }
+
+    print $xs_fh <<EOCONSTANT
+  }
 
 void
 $xs_subname(sv)