INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE

Message-ID: <20010614235256.G98663@plum.flirble.org>

p4raw-id: //depot/perl@10601

1 files changed, 103 insertions, 55 deletions

diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm
index 41341c90a3..024d8ccfab 100644
--- a/lib/ExtUtils/Constant.pm
+++ b/lib/ExtUtils/Constant.pm
@@ -1,6 +1,6 @@
 package ExtUtils::Constant;
 use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
-$VERSION = '0.05';
+$VERSION = '0.06';
 
 =head1 NAME
 
@@ -57,6 +57,10 @@ NUL terminated string, length will be determined with C<strlen>
 A fixed length thing, given as a [pointer, length] pair. If you know the
 length of a string at compile time you may use this instead of I<PV>
 
+=item PVN
+
+A B<mortal> SV.
+
 =item YES
 
 Truth.  (C<PL_sv_yes>)  The value is not needed (and ignored).
@@ -97,22 +101,24 @@ $Text::Wrap::columns = 80;
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 %XS_Constant = (
-                IV => 'PUSHi(iv)',
-                UV => 'PUSHu((UV)iv)',
-                NV => 'PUSHn(nv)',
-                PV => 'PUSHp(pv, strlen(pv))',
-                PVN => 'PUSHp(pv, iv)',
-		YES => 'PUSHs(&PL_sv_yes)',
-		NO => 'PUSHs(&PL_sv_no)',
+		IV    => 'PUSHi(iv)',
+		UV    => 'PUSHu((UV)iv)',
+		NV    => 'PUSHn(nv)',
+		PV    => 'PUSHp(pv, strlen(pv))',
+		PVN   => 'PUSHp(pv, iv)',
+		SV    => 'PUSHs(sv)',
+		YES   => 'PUSHs(&PL_sv_yes)',
+		NO    => 'PUSHs(&PL_sv_no)',
 		UNDEF => '',	# implicit undef
 );
 
 %XS_TypeSet = (
-                IV => '*iv_return =',
-                UV => '*iv_return = (IV)',
-                NV => '*nv_return =',
-                PV => '*pv_return =',
-                PVN => ['*pv_return =', '*iv_return = (IV)'],
+		IV    => '*iv_return =',
+		UV    => '*iv_return = (IV)',
+		NV    => '*nv_return =',
+		PV    => '*pv_return =',
+		PVN   => ['*pv_return =', '*iv_return = (IV)'],
+		SV    => '*sv_return = ',
 		YES   => undef,
 		NO    => undef,
 		UNDEF => undef,
@@ -209,11 +215,13 @@ sub memEQ_clause {
   return $body;
 }
 
-=item assign INDENT, TYPE, VALUE...
+=item assign INDENT, TYPE, PRE, POST, VALUE...
 
 A function to return a suitable assignment clause. If I<TYPE> is aggregate
 (eg I<PVN> expects both pointer and length) then there should be multiple
-I<VALUE>s for the components.
+I<VALUE>s for the components. I<PRE> and I<POST> if defined give snippets
+of C code to preceed and follow the assignment. I<PRE> will be at the start
+of a block, so variables may be defined in it.
 
 =cut
 
@@ -222,7 +230,18 @@ I<VALUE>s for the components.
 sub assign {
   my $indent = shift;
   my $type = shift;
+  my $pre = shift;
+  my $post = shift || '';
   my $clause;
+  my $close;
+  if ($pre) {
+    chomp $pre;
+    $clause = $indent . "{\n$pre";
+    $clause .= ";" unless $pre =~ /;$/;
+    $clause .= "\n";
+    $close = "$indent}\n";
+    $indent .= "  ";
+  }
   die "Can't generate code for type $type" unless exists $XS_TypeSet{$type};
   my $typeset = $XS_TypeSet{$type};
   if (ref $typeset) {
@@ -236,11 +255,18 @@ sub assign {
       if @_ > 1;
     $clause .= $indent . "$typeset $_[0];\n";
   }
+  chomp $post;
+  if (length $post) {
+    $clause .= "$post";
+    $clause .= ";" unless $post =~ /;$/;
+    $clause .= "\n";
+  }    
   $clause .= "${indent}return PERL_constant_IS$type;\n";
+  $clause .= $close if $close;
   return $clause;
 }
 
-=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT
+=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT, PRE, POST, PRE, POST
 
 A function to return a suitable C<#ifdef> clause. I<MACRO> defaults to
 I<VALUE> when not defined.  If I<TYPE> is aggregate (eg I<PVN> expects both
@@ -249,17 +275,20 @@ values in the order expected by the type.  C<C_constant> will always call
 this function with I<MACRO> defined, defaulting to the constant's name.
 I<DEFAULT> if defined is an array reference giving default type and and
 value(s) if the clause generated by I<MACRO> doesn't evaluate to true.
+The two pairs I<PRE> and I<POST> if defined give C code snippets to proceed
+and follow the value, and the default value.
 
 =cut
 
-sub return_clause ($$$$$) {
+sub return_clause ($$$$$$$$$) {
 ##ifdef thingy
 #      *iv_return = thingy;
 #      return PERL_constant_ISIV;
 ##else
 #      return PERL_constant_NOTDEF;
 ##endif
-  my ($value, $type, $indent, $macro, $default) = @_;
+  my ($value, $type, $indent, $macro, $default, $pre, $post,
+      $def_pre, $def_post) = @_;
   $macro = $value unless defined $macro;
   $indent = ' ' x ($indent || 6);
 
@@ -274,7 +303,8 @@ sub return_clause ($$$$$) {
 
   #      *iv_return = thingy;
   #      return PERL_constant_ISIV;
-  $clause .= assign ($indent, $type, ref $value ? @$value : $value);
+  $clause .= assign ($indent, $type, $pre, $post,
+                     ref $value ? @$value : $value);
 
   ##else
   $clause .= "#else\n";
@@ -283,7 +313,9 @@ sub return_clause ($$$$$) {
   if (!defined $default) {
     $clause .= "${indent}return PERL_constant_NOTDEF;\n";
   } else {
-    $clause .= assign ($indent, ref $default ? @$default : $default);
+    my @default = ref $default ? @$default : $default;
+    $type = shift @default;
+    $clause .= assign ($indent, $type, $def_pre, $def_post, @default);
   }
 
   ##endif
@@ -363,14 +395,16 @@ sub switch_clause {
     $body .= $indent . "case '" . C_stringify ($char) . "':\n";
     foreach my $name (sort @{$best->{$char}}) {
       my $thisone = $items->{$name};
-      my ($value, $macro, $default) = @$thisone{qw (value macro default)};
+      my ($value, $macro, $default, $pre, $post, $def_pre, $def_post)
+        = @$thisone{qw (value macro default pre post def_pre def_post)};
       $value = $name unless defined $value;
       $macro = $name unless defined $macro;
 
       # We have checked this offset.
       $body .= memEQ_clause ($name, $offset, 2 + length $indent);
       $body .= return_clause ($value, $thisone->{type},  4 + length $indent,
-                              $macro, $default);
+                              $macro, $default, $pre, $post,
+                              $def_pre, $def_post);
       $body .= $indent . "  }\n";
     }
     $body .= $indent . "  break;\n";
@@ -396,7 +430,8 @@ sub params {
   my $use_iv = $what->{IV} || $what->{UV} || $what->{PVN};
   my $use_nv = $what->{NV};
   my $use_pv = $what->{PV} || $what->{PVN};
-  return ($use_iv, $use_nv, $use_pv);
+  my $use_sv = $what->{SV};
+  return ($use_iv, $use_nv, $use_pv, $use_sv);
 }
 
 =item dump_names  
@@ -416,7 +451,9 @@ sub dump_names {
     my $type = $_->{type} || $default_type;
     if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
         and !defined ($_->{macro}) and !defined ($_->{value})
-        and !defined ($_->{default})) {
+        and !defined ($_->{default}) and !defined ($_->{pre})
+        and !defined ($_->{post}) and !defined ($_->{def_pre})
+        and !defined ($_->{def_post})) {
       # It's the default type, and the name consists only of A-Za-z0-9_
       push @simple, $_->{name};
     } else {
@@ -445,32 +482,17 @@ EOT
   if (@complex) {
     foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
       my $name = C_stringify $item->{name};
-      my ($macro, $value, $default) = @$item{qw (macro value default)};
       my $line = ",\n            {name=>\"$name\"";
       $line .= ", type=>\"$item->{type}\"" if defined $item->{type};
-      if (defined $macro) {
-        if (ref $macro) {
-          $line .= ', macro=>["'. join ('", "', map {C_stringify $_} @$macro)
-            . '"]';
-        } else {
-          $line .= ", macro=>\"" . C_stringify($macro) . "\"";
-        }
-      }
-      if (defined $value) {
-        if (ref $value) {
-          $line .= ', value=>["'. join ('", "', map {C_stringify $_} @$value)
-            . '"]';
-        } else {
-          $line .= ", value=>\"" . C_stringify($value) . "\"";
-        }
-      }
-      if (defined $default) {
-        if (ref $default) {
-          $line .= ', default=>["'. join ('", "', map {C_stringify $_}
-                                          @$default)
-            . '"]';
-        } else {
-          $line .= ", default=>\"" . C_stringify($default) . "\"";
+      foreach my $thing (qw (macro value default pre post def_pre def_post)) {
+        my $value = $item->{$thing};
+        if (defined $value) {
+          if (ref $value) {
+            $line .= ", $thing=>[\""
+              . join ('", "', map {C_stringify $_} @$value) . '"]';
+          } else {
+            $line .= ", $thing=>\"" . C_stringify($value) . "\"";
+          }
         }
       }
       $line .= "}";
@@ -561,6 +583,24 @@ Default value to use (instead of C<croak>ing with "your vendor has not
 defined...") to return if the macro isn't defined. Specify a reference to
 an array with type followed by value(s).
 
+=item pre
+
+C code to use before the assignment of the value of the constant. This allows
+you to use temporary variables to extract a value from part of a C<struct>
+and return this as I<value>. This C code is places at the start of a block,
+so you can declare variables in it.
+
+=item post
+
+C code to place between the assignment of value (to a temporary) and the
+return from the function. This allows you to clear up anything in I<pre>.
+Rarely needed.
+
+=item def_pre
+=item def_post
+
+Equivalents of I<pre> and I<post> for the default value.
+
 =back
 
 I<PACKAGE> is the name of the package, and is only used in comments inside the
@@ -625,9 +665,10 @@ sub C_constant {
   foreach (@items) {
     my $name;
     if (ref $_) {
+      my $orig = $_;
       # Make a copy which is a normalised version of the ref passed in.
       $name = $_->{name};
-      my ($type, $macro, $value, $default) = @$_{qw (type macro value default)};
+      my ($type, $macro, $value) = @$_{qw (type macro value)};
       $type ||= $default_type;
       $what->{$type} = 1;
       $_ = {name=>$name, type=>$type};
@@ -636,7 +677,11 @@ sub C_constant {
       $_->{macro} = $macro if defined $macro;
       undef $value if defined $value and $value eq $name;
       $_->{value} = $value if defined $value;
-      $_->{default} = $default if defined $default;
+      foreach my $key (qw(default pre post def_pre def_post)) {
+        my $value = $orig->{$key};
+        $_->{$key} = $value if defined $value;
+        # warn "$key $value";
+      }
     } else {
       $name = $_;
       $_ = {name=>$_, type=>$default_type};
@@ -648,13 +693,14 @@ sub C_constant {
     }
     $items{$name} = $_;
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
 
   my ($body, @subs) = "static int\n$subname (const char *name";
   $body .= ", STRLEN len" unless defined $namelen;
   $body .= ", IV *iv_return" if $use_iv;
   $body .= ", NV *nv_return" if $use_nv;
   $body .= ", const char **pv_return" if $use_pv;
+  $body .= ", SV **sv_return" if $use_sv;
   $body .= ") {\n";
 
   if (defined $namelen) {
@@ -679,14 +725,14 @@ sub C_constant {
       $body .= "  case $i:\n";
       if (@{$by_length[$i]} == 1) {
         my $thisone = $by_length[$i]->[0];
-        my ($name, $value, $macro, $default)
-          = @$thisone{qw (name value macro default)};
+        my ($name, $value, $macro, $default, $pre, $post, $def_pre, $def_post)
+          = @$thisone{qw (name value macro default pre post def_pre def_post)};
         $value = $name unless defined $value;
         $macro = $name unless defined $macro;
 
         $body .= memEQ_clause ($name);
         $body .= return_clause ($value, $thisone->{type}, undef, $macro,
-                                $default);
+                                $default, $pre, $post, $def_pre, $def_post);
         $body .= "    }\n";
       } elsif (@{$by_length[$i]} < $breakout) {
         $body .= switch_clause (4, '', $i, \%items, @{$by_length[$i]});
@@ -697,6 +743,7 @@ sub C_constant {
         $body .= ", iv_return" if $use_iv;
         $body .= ", nv_return" if $use_nv;
         $body .= ", pv_return" if $use_pv;
+        $body .= ", sv_return" if $use_sv;
         $body .= ");\n";
       }
       $body .= "    break;\n";
@@ -739,7 +786,7 @@ sub XS_constant {
     # Convert line of the form IV,UV,NV to hash
     $what = {map {$_ => 1} split /,\s*/, ($what)};
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
   my $type;
 
   my $xs = <<"EOT";
@@ -789,6 +836,7 @@ EOT
   $xs .= ', &iv' if $use_iv;
   $xs .= ', &nv' if $use_nv;
   $xs .= ', &pv' if $use_pv;
+  $xs .= ', &sv' if $use_sv;
   $xs .= ");\n";
 
   $xs .= << "EOT";