Fix broken test for empty _WRAP_METHOD argument

* tools/pm/DocsParser.pm: Escape variable values substituted into
regular expressions.
* tools/pm/Output.pm (output_wrap_property): Transliterate using
tr/// instead of s///g.
* tools/pm/WrapParser.pm: Correct a number of worst offenders among
all the horrible Perl code.
(on_wrap_{ctor,method,corba_method}): Instead of testing whether
the prototype argument does not consist solely of non-whitespace
characters, actually do what the accompanying comment claimed and
test whether the argument is empty or consists only of whitespace.
The only reason this age-old bug was never triggered is that there
is always at least one whitespace character in a prototype, namely
between the return type and the function name.  The only exception
would be the default constructor, which however just so happens to
have its own special _CTOR_DEFAULT macro.
In a nutshell, the bug itself was broken and failed to properly
break things.

4 files changed, 75 insertions, 75 deletions

diff --git a/ChangeLog b/ChangeLog
index 5a2db8b5..6415bfa5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,27 @@
 2009-09-10  Daniel Elstner  <danielk@openismus.com>
 
+	Fix broken test for empty _WRAP_METHOD argument
+
+	* tools/pm/DocsParser.pm: Escape variable values substituted into
+	regular expressions.
+	* tools/pm/Output.pm (output_wrap_property): Transliterate using
+	tr/// instead of s///g.
+	* tools/pm/WrapParser.pm: Correct a number of worst offenders among
+	all the bad Perl code.
+	(on_wrap_{ctor,method,corba_method}): Instead of testing whether
+	the prototype argument does not consist solely of non-whitespace
+	characters, actually do what the accompanying comment claimed and
+	test whether the argument is empty or consists only of whitespace.
+	The only reason this age-old bug was never triggered is that there
+	is always at least one whitespace character in a prototype, namely
+	between the return type and the function name.  The only exception
+	would be the default constructor, which however just so happens to
+	have its own special _CTOR_DEFAULT macro.
+	In a nutshell, the bug itself was broken and failed to properly
+	break things.
+
+2009-09-10  Daniel Elstner  <danielk@openismus.com>
+
 	Re-enable input file line markers in gmmproc
 
 	* tools/pm/WrapParser.pm: Replace hairy uses of scalar(@array)
diff --git a/tools/pm/DocsParser.pm b/tools/pm/DocsParser.pm
index 8072b4e3..fed5d49b 100644
--- a/tools/pm/DocsParser.pm
+++ b/tools/pm/DocsParser.pm
@@ -448,7 +448,7 @@ sub substitute_function($$)
 sub non_object_method_name($$)
 {
   my ($doc_func, $name) = @_;
-  if ($$name =~ "^gtk_")
+  if ($$name =~ m/^gtk_/)
   {
     my %gtk_objects = ("gtk_accel_map" => "AccelMap",
                        "gtk_clipboard" => "Clipboard",
@@ -465,7 +465,7 @@ sub non_object_method_name($$)
                        "gtk_recent_filter" => "RecentFilter");
     foreach my $key (keys(%gtk_objects))
     {
-      if ($$name =~ "^$key")
+      if ($$name =~ m/^\Q$key\E/)
       {
         DocsParser::build_method_name($doc_func, "Gtk", $gtk_objects{$key}, $name);
         return;
@@ -503,7 +503,7 @@ sub lookup_object_of_method($$)
   foreach(@parts) { $_ = (length > 2) ? ucfirst : uc; }
 
   # Do a bit of try'n'error.
-  while(scalar(@parts) > 1)
+  while($#parts >= 1)
   {
     my $try = join("", @parts);
 
@@ -526,10 +526,10 @@ sub build_method_name($$$$)
   $prefix =~ s/([a-z])([A-Z])/$1_$2/g;
   $prefix = lc($prefix) . '_';
 
-  if($$name =~ /^$prefix/)
+  if($$name =~ m/^\Q$prefix\E/)
   {
     my $scope = "";
-    $scope = "${module}::${class}::" unless($doc_func =~ /^$prefix/);
+    $scope = "${module}::${class}::" unless($doc_func =~ m/^\Q$prefix\E/);
 
     substr($$name, 0, length($prefix)) = $scope;
   }
diff --git a/tools/pm/Output.pm b/tools/pm/Output.pm
index e1c811a1..40a381f6 100644
--- a/tools/pm/Output.pm
+++ b/tools/pm/Output.pm
@@ -616,7 +616,7 @@ sub output_wrap_property($$$$$$)
 
     # Convert - to _ so we can use it in C++ method and variable names:
     my $name_underscored = $name;
-    $name_underscored =~ s/-/_/g;
+    $name_underscored =~ tr/-/_/;
 
     my $str = sprintf("_PROPERTY_PROXY(%s,%s,%s,%s,%s)dnl\n",
       $name,
diff --git a/tools/pm/WrapParser.pm b/tools/pm/WrapParser.pm
index ea3ab922..dacdb908 100644
--- a/tools/pm/WrapParser.pm
+++ b/tools/pm/WrapParser.pm
@@ -173,15 +173,15 @@ sub extract_token($)
     # skip empty tokens
     next if ( !defined($_) or $_ eq "" );
 
-    # eat line statements. TODO: e.g.?
-    if ( /^#l (\S+)\n/)
+    # eat line statements
+    if (m/^#l (\S+)\n/)
     {
       $$self{line_num} = $1;
       next;
     }
 
-    # eat file statements. TODO: e.g.?
-    if ( /^#f (\S+)\n/)
+    # eat file statements
+    if (m/^#f (\S+)\n/)
     {
       $$self{filename} = $1;
       next;
@@ -209,13 +209,13 @@ sub peek_token($)
     {
       shift @tokens;
     }
-    # eat line statements. TODO: e.g.?
+    # eat line statements
     elsif ( /^#l (\S+)\n/)
     {
       $$self{line_num} = $1;
       shift @tokens;
     }
-    # eat file statements. TODO: e.g.?
+    # eat file statements
     elsif ( /^#f (\S+)\n/)
     {
       $$self{filename} = $1;
@@ -337,7 +337,7 @@ sub on_comment_doxygen($)
       # can print it if the next real token is not _WRAP_SIGNAL
       my @whitespace;
       my $next_token = $self->peek_token();
-      while ($next_token =~ /^\s*$/)
+      while ($next_token !~ /\S/)
       {
         push(@whitespace, $self->extract_token());
 	$next_token = $self->peek_token();
@@ -356,12 +356,12 @@ sub on_comment_doxygen($)
       }
       else
       {
-        # Something else then signal follows, so close comment normally
+        # Something other than signal follows, so close comment normally
         $objOutputter->append("/");
-	# And append whitespace we ignored so far
+        # And append whitespace we ignored so far
         $objOutputter->append(join("", @whitespace));
-	# Do not extract the token so that parse_and_build_output() will
-	# process it.
+        # Do not extract the token so that parse_and_build_output() will
+        # process it.
       }
 
       last;
@@ -790,7 +790,7 @@ sub check_for_eof($)
   my $filename = $$self{filename};
   my $line_num = $$self{line_num};
 
-  if (!(scalar(@tokens)))
+  unless (scalar(@tokens))
   {
     print STDERR "$filename:$line_num:hit eof in _WRAP\n";
     return 0; #EOF
@@ -805,10 +805,7 @@ sub on_wrap_method($)
   my ($self) = @_;
   my $objOutputter = $$self{objOutputter};
 
-  if( !($self->check_for_eof()) )
-  {
-   return;
-  }
+  return unless ($self->check_for_eof());
 
   my $filename = $$self{filename};
   my $line_num = $$self{line_num};
@@ -818,7 +815,7 @@ sub on_wrap_method($)
 
   my $entity_type = "method";
 
-  if (!$$self{in_class})
+  unless ($$self{in_class})
     {
       print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
       return;
@@ -829,17 +826,14 @@ sub on_wrap_method($)
 
   # handle first argument
   my $argCppMethodDecl = $args[0];
-  if ($argCppMethodDecl =~ /^\S+$/ ) #Checks that it's not empty and that it contains no whitespace.
+  if ($argCppMethodDecl !~ m/\S/s)
   {
-    print STDERR "$filename:$line_num:_WRAP can't handle unspecified method $argCppMethodDecl\n";
+    print STDERR "$filename:$line_num:_WRAP_METHOD: missing prototype\n";
     return;
   }
-  else
-  {
-    #Parse the method decaration and build an object that holds the details:
-    $objCppfunc = &Function::new($argCppMethodDecl, $self);
-  }
 
+  #Parse the method decaration and build an object that holds the details:
+  $objCppfunc = &Function::new($argCppMethodDecl, $self);
 
   # handle second argument:
 
@@ -848,8 +842,8 @@ sub on_wrap_method($)
 
   #Get the c function's details:
 
-  #Checks that it's not empty and that it contains no whitespace.
-  if ($argCFunctionName =~ /^\S+$/ )
+  # Checks that it's not empty and that it contains no whitespace.
+  if ($argCFunctionName =~ m/^\S+$/s)
   {
     #c-name. e.g. gtk_clist_set_column_title
     $objCfunc = GtkDefs::lookup_function($argCFunctionName);
@@ -933,10 +927,10 @@ sub on_wrap_method_docs_only($)
   my $argCFunctionName = $args[0];
   $argCFunctionName = string_trim($argCFunctionName);
 
-  #Get the c function's details:
+  # Get the C function's details:
 
-  #Checks that it's not empty and that it contains no whitespace.
-  if ($argCFunctionName =~ /^\S+$/ ) 
+  # Checks that it's not empty or contains whitespace
+  if ($argCFunctionName =~ m/^\S+$/s)
   {
     #c-name. e.g. gtk_clist_set_column_title
     $objCfunc = GtkDefs::lookup_function($argCFunctionName);
@@ -993,25 +987,22 @@ sub on_wrap_ctor($)
 
   # handle first argument
   my $argCppMethodDecl = $args[0];
-  if ($argCppMethodDecl =~ /^\S+$/ ) #Checks that it's not empty and that it contains no whitespace.
+  if ($argCppMethodDecl !~ m/\S/s)
     {
-      print STDERR "$filename:$line_num:_WRAP_CTOR can't handle unspecified method $argCppMethodDecl\n";
+      print STDERR "$filename:$line_num:_WRAP_CTOR: missing prototype\n";
       return;
     }
-  else
-    {
-      #Parse the method decaration and build an object that holds the details:
-      $objCppfunc = &Function::new_ctor($argCppMethodDecl, $self);
-    }
 
+  #Parse the method decaration and build an object that holds the details:
+  $objCppfunc = &Function::new_ctor($argCppMethodDecl, $self);
 
   # handle second argument:
 
   my $argCFunctionName = $args[1];
   $argCFunctionName = string_trim($argCFunctionName);
 
-  #Get the c function's details:
-  if ($argCFunctionName =~ /^\S+$/ ) #Checks that it's not empty and that it contains no whitespace.
+  #Get the C function's details:
+  if ($argCFunctionName =~ m/^\S+$/s)
   {
     $objCfunc = GtkDefs::lookup_function($argCFunctionName); #c-name. e.g. gtk_clist_set_column_title
     if(!$objCfunc) #If the lookup failed:
@@ -1221,7 +1212,7 @@ sub on_wrap_gerror($)
 {
   my ($self) = @_;
 
-  return if(!$self->check_for_eof());
+  return unless ($self->check_for_eof());
 
   # get the arguments
   my @args = string_split_commas($self->extract_bracketed_text());
@@ -1241,10 +1232,7 @@ sub on_wrap_property($)
   my ($self) = @_;
   my $objOutputter = $$self{objOutputter};
 
-  if( !($self->check_for_eof()) )
-  {
-    return;
-  }
+  return unless ($self->check_for_eof());
 
   my $str = $self->extract_bracketed_text();
   my @args = string_split_commas($str);
@@ -1276,20 +1264,17 @@ sub output_wrap_check($$$$$$)
 
   #Some checks:
 
-
-  if (!$$self{in_class})
+  unless ($$self{in_class})
   {
     print STDERR "$filename:$line_num: $macro_name macro encountered outside class\n";
-    return;
+    return 1;
   }
-
-  if ($CppDecl =~ /^\S+$/ ) #If it's not empty and it contains no whitespace.
+  if ($CppDecl !~ m/\S/s)
   {
-    print STDERR "$filename:$line_num:$macro_name can't handle unspecified entity $CppDecl\n";
-    return;
+    print STDERR "$filename:$line_num:$macro_name: missing prototype\n";
+    return 1;
   }
-
-
+  return '';
 }
 
 # void output_wrap($CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback, $bRefreturn)
@@ -1299,8 +1284,8 @@ sub output_wrap_signal($$$$$$$$$)
   my ($self, $CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback, $bRefreturn, $ifdef, $merge_doxycomment_with_previous) = @_;
   
   #Some checks:
-  $self->output_wrap_check($CppDecl, $signal_name, $filename, $line_num, "WRAP_SIGNAL");
-
+  return if ($self->output_wrap_check($CppDecl, $signal_name,
+                                      $filename, $line_num, "_WRAP_SIGNAL"));
   # handle first argument
 
   #Parse the method decaration and build an object that holds the details:
@@ -1314,7 +1299,7 @@ sub output_wrap_signal($$$$$$$$$)
   my $objOutputter = $$self{objOutputter};
 
   #Get the c function's details:
-  if ($signal_name ne "" ) #If it's not empty and it contains no whitespace.
+  if ($signal_name ne '')
   {
     $objCSignal = GtkDefs::lookup_signal($$self{c_class}, $signal_name);
 
@@ -1347,7 +1332,7 @@ sub output_wrap_vfunc($$$$$$$$)
   my ($self, $CppDecl, $vfunc_name, $refreturn, $refreturn_ctype, $filename, $line_num, $ifdef) = @_;
 
   #Some checks:
-  $self->output_wrap_check($CppDecl, $vfunc_name, $filename, $line_num, "VFUNC");
+  return if ($self->output_wrap_check($CppDecl, $vfunc_name, $filename, $line_num, '_WRAP_VFUNC'));
 
   # handle first argument
 
@@ -1361,7 +1346,7 @@ sub output_wrap_vfunc($$$$$$$$)
   my $objOutputter = $$self{objOutputter};
 
   #Get the c function's details:
-  if ($vfunc_name =~ /^\S+$/ ) #If it's not empty and it contains no whitespace.
+  if ($vfunc_name =~ m/^\S+$/s) # if it's not empty and contains no whitespace
   {
     $objCVfunc = GtkDefs::lookup_signal($$self{c_class},$vfunc_name);
     if(!$objCVfunc) #If the lookup failed:
@@ -1405,10 +1390,7 @@ sub on_wrap_corba_method($)
   my ($self) = @_;
   my $objOutputter = $$self{objOutputter};
 
-  if( !($self->check_for_eof()) )
-  {
-   return;
-  }
+  return unless ($self->check_for_eof());
 
   my $filename = $$self{filename};
   my $line_num = $$self{line_num};
@@ -1424,22 +1406,18 @@ sub on_wrap_corba_method($)
       return;
     }
 
-  my $objCfunc;
   my $objCppfunc;
 
   # handle first argument
   my $argCppMethodDecl = $args[0];
-  if ($argCppMethodDecl =~ /^\S+$/ ) #Checks that it's not empty and that it contains no whitespace.
+  if ($argCppMethodDecl !~ m/\S/s)
   {
-    print STDERR "$filename:$line_num:_WRAP can't handle unspecified method $argCppMethodDecl\n";
+    print STDERR "$filename:$line_num:_WRAP_CORBA_METHOD: missing prototype\n";
     return;
   }
-  else
-  {
-    #Parse the method decaration and build an object that holds the details:
-    $objCppfunc = &Function::new($argCppMethodDecl, $self);
-  }
 
+  # Parse the method decaration and build an object that holds the details:
+  $objCppfunc = &Function::new($argCppMethodDecl, $self);
   $objOutputter->output_wrap_corba_method($filename, $line_num, $objCppfunc);
 }