big Configure update from Jarkko: sync metaconfig units; d_statblks fix

[p5sagit/p5-mst-13.2.git] / win32 / GenCAPI.pl

diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
index 09827f2..a4e4099 100644 (file)
--- a/win32/GenCAPI.pl
+++ b/win32/GenCAPI.pl
@@ -141,10 +141,14 @@ while () {
             @args = split(',', $args);
             if ($args[$#args] =~ /\s*\.\.\.\s*/) {
                 if(($name eq "croak") or ($name eq "deb") or ($name eq "die")
-                       or ($name eq "form") or ($name eq "warn")) {
+                       or ($name eq "form") or ($name eq "warn")
+                       or ($name eq "warner")) {
                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
-                    $args[0] =~ /(\w+)\W*$/; 
-                    $arg = $1;
+                    for (@args) { $_ = $1 if /(\w+)\W*$/; }
+                    $arg = $args[$#args-1];
+                   my $start = '';
+                   $start = join(', ',@args[0 .. ($#args - 2)]) if @args > 2;
+                   $start .= ', ' if $start;
                     print OUTFILE <<ENDCODE;
 
 #undef $name
@@ -157,7 +161,7 @@ extern "C" $type $funcName ($args)
     pmsg = pPerl->Perl_mess($arg, &args);
     New(0, pstr, strlen(pmsg)+1, char);
     strcpy(pstr, pmsg);
-$return pPerl->Perl_$name(pstr);
+$return pPerl->Perl_$name($start pstr);
     va_end(args);
 }
 ENDCODE
@@ -202,6 +206,29 @@ extern "C" $type $funcName ($args)
 ENDCODE
                     print OUTFILE "#endif\n" unless ($separateObj == 0);
                 }
+                elsif($name eq "sv_catpvf_mg") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg0 = $1;
+                    $args[1] =~ /(\w+)\W*$/; 
+                    $arg1 = $1;
+                    print OUTFILE <<ENDCODE;
+
+#undef $name
+#ifndef mg_set
+#define mg_set pPerl->Perl_mg_set
+#endif
+extern "C" $type $funcName ($args)
+{
+    va_list args;
+    va_start(args, $arg1);
+    pPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+    va_end(args);
+    SvSETMAGIC(sv);
+}
+ENDCODE
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
                 elsif($name eq "sv_setpvf") {
                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
                     $args[0] =~ /(\w+)\W*$/; 
@@ -221,6 +248,29 @@ extern "C" $type $funcName ($args)
 ENDCODE
                     print OUTFILE "#endif\n" unless ($separateObj == 0);
                 }
+                elsif($name eq "sv_setpvf_mg") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg0 = $1;
+                    $args[1] =~ /(\w+)\W*$/; 
+                    $arg1 = $1;
+                    print OUTFILE <<ENDCODE;
+
+#undef $name
+#ifndef mg_set
+#define mg_set pPerl->Perl_mg_set
+#endif
+extern "C" $type $funcName ($args)
+{
+    va_list args;
+    va_start(args, $arg1);
+    pPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+    va_end(args);
+    SvSETMAGIC(sv);
+}
+ENDCODE
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
                 elsif($name eq "fprintf") {
                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
                     $args[0] =~ /(\w+)\W*$/; 
@@ -376,6 +426,7 @@ mess_sv
 ors
 opsave
 eval_mutex
+strtab_mutex
 orslen
 ofmt
 modcount
@@ -442,6 +493,7 @@ threads_mutex
 malloc_mutex
 svref_mutex
 sv_mutex
+cred_mutex
 nthreads_cond
 eval_cond
 cryptseen