From 32ad087f427fba8a64694c5e1473e08f5152f136 Mon Sep 17 00:00:00 2001
From: Guillaume Cottenceau <gc@mandriva.com>
Date: Mon, 28 Apr 2003 16:04:10 +0000
Subject: methods not naming arguments

---
 perl_checker_fake_packages/gen.pl | 34 ++++++++++++++++++++++++++--------
 1 file changed, 26 insertions(+), 8 deletions(-)

diff --git a/perl_checker_fake_packages/gen.pl b/perl_checker_fake_packages/gen.pl
index eec88b6..4aa5c0c 100755
--- a/perl_checker_fake_packages/gen.pl
+++ b/perl_checker_fake_packages/gen.pl
@@ -16,27 +16,45 @@ sub gtk2 {
         each_index {
             if (/^\s*sub\s+(\w+)/) {
                 my $fun = $1;
+
+                #- obtain first statement of function
+                local $_ = $_;
+                if (/^\s*sub\s+\w+\s*{?\s*$/) {
+                    if ($contents[$::i+1] =~ /^\s*{\s*$/) {
+                        $_ .= $contents[$::i+1] . $contents[$::i+2];
+                    } else {
+                        $_ .= $contents[$::i+1];
+                    }
+                }
+
+                my $subroutine_decl = '^\s*sub\s+\w+\s*{\s*';
+
                 #- one liner constants
                 #-   sub EXPOSURE_MASK { 'exposure-mask' }
-                /^\s*sub\s+(\w+)\s*{\s*('[^']+')|("[^"]+")\s*}/ and $add->($fun, '() {}');
+                /$subroutine_decl('[^']+')|("[^"]+")\s*}/ and $add->($fun, '() {}');
                 #-   sub Sym_Hangul_J_Phieuf { 0xeed }
-                /^\s*sub\s+(\w+)\s*{\s*0\S+\s*}/                and $add->($fun, '() {}');
-
-                #- explore first line of subroutine definition
-                local $_ = $contents[$::i+1];
-                /^\s*{\s*$/ and $_ = $contents[$::i+2];
+                /$subroutine_decl\0\S+\s*}/                and $add->($fun, '() {}');
 
                 #- traditional form
                 #-   my ($class, $interval, $func, $data) = @_;
-                if (/^\s*my\s*\(([^\)]+)\)\s*=\s*\@_\s*;\s*$/) {
+                if (/$subroutine_decl\my\s*\(([^\)]+)\)\s*=\s*\@_\s*;\s*$/) {
                     my @args = map { /^\s*\$(.*)/ or goto skip_trad; '$_'.$1 } split /,/, $1;
                     $add->($fun, ' { my ('.join(', ', @args).') = @_ }');
                   skip_trad:
                 }
 
+                #- methods not naming arguments
+                #-   sub set_name { $_[0]->set_property('name', $_[1]) }
+                if (/$subroutine_decl([^}]+)\s*}\s*$/) {
+                    my $statement = $1;
+                    if ($statement !~ /\$[a-zA-Z]/ && $statement !~ /\@_/ && $statement =~ /.*\$_\[(\d+)\]/) {
+                        $add->($fun, ' { my ('.join(', ', map { '$_DUMMY'.$_ } 0..$1).') = @_ }');
+                    }
+                }
+
                 #- methods with no argument
                 #-   my $values = shift->_get_size_request;
-                if (/shift->\w+\s*;/) {
+                if (/$subroutine_decl\shift->\w+\s*;/) {
                     $add->($fun, ' { my ($_self) = @_ }');
                 }
 
-- 
cgit v1.2.1