/[suikacvs]/messaging/manakai/bin/domtest2perl.pl
Suika

Diff of /messaging/manakai/bin/domtest2perl.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Sun Oct 10 06:09:47 2004 UTC revision 1.4 by wakaba, Sat Oct 16 13:34:56 2004 UTC
# Line 24  if (defined $output_filename) { Line 24  if (defined $output_filename) {
24    $output_file = \*STDOUT;    $output_file = \*STDOUT;
25  }  }
26    
27  our $Method;  our $Method;
28    our $IFMethod;
29  our $Attr;  our $Attr;
 our $MethodParam;  
30  my $Assert = {  my $Assert = {
31    qw/assertDOMException 1    qw/assertDOMException 1
32       assertFalse 1       assertFalse 1
33       assertNotNull 1       assertNotNull 1
34       assertNull 1       assertNull 1
35         assertSize 1
36       assertTrue 1/       assertTrue 1/
37  };  };
38  my $Misc = {  my $Misc = {
# Line 182  sub node2code ($) { Line 183  sub node2code ($) {
183                             local_name => $node->getAttributeNS (undef, 'var')).                             local_name => $node->getAttributeNS (undef, 'var')).
184                   ' = '                   ' = '
185          if $node->hasAttributeNS (undef, 'var');          if $node->hasAttributeNS (undef, 'var');
186          my $param;
187          if ($node->hasAttributeNS (undef, 'interface')) {
188            $param = $IFMethod->{$node->getAttributeNS (undef, 'interface')}
189                              ->{$ln};
190          } else {
191            $param = $Method->{$ln};
192          }
193        $result .= perl_var (type => '$',        $result .= perl_var (type => '$',
194                             local_name => $node->getAttributeNS (undef, 'obj')).                             local_name => $node->getAttributeNS (undef, 'obj')).
195                '->'.$ln.' ('.                '->'.$ln.' ('.
# Line 189  sub node2code ($) { Line 197  sub node2code ($) {
197                       map {                       map {
198                         to_perl_value ($node->getAttributeNS (undef, $_),                         to_perl_value ($node->getAttributeNS (undef, $_),
199                                        default => 'undef')                                        default => 'undef')
200                       } @{$Method->{$ln}}).                       } @$param).
201                ");\n";                ");\n";
202      } elsif ($Attr->{$ln}) {      } elsif ($Attr->{$ln}) {
203        if ($node->hasAttributeNS (undef, 'var')) {        if ($node->hasAttributeNS (undef, 'var')) {
# Line 240  sub node2code ($) { Line 248  sub node2code ($) {
248                   );                   );
249        $result .= ");\n";        $result .= ");\n";
250      $Status->{Number}++;      $Status->{Number}++;
251      } elsif ($ln eq 'assertSize') {
252        my $size = to_perl_value ($node->getAttributeNS (undef, 'size'));
253        my $coll = to_perl_value ($node->getAttributeNS (undef, 'collection'));
254        $result .= perl_statement 'assertSize ('.
255                     perl_list
256                       ($node->getAttributeNS (undef, 'id'),
257                        perl_code_literal $size, perl_code_literal $coll).
258                   ')';
259        if ($node->hasChildNodes) {
260          $result .= perl_if
261                       qq<$size == size ($coll)>,
262                       block2code ($node);
263        }
264    } elsif ($ln eq 'assertTrue' or $ln eq 'assertFalse') {    } elsif ($ln eq 'assertTrue' or $ln eq 'assertFalse') {
265        my $condition;        my $condition;
266        if ($node->hasAttributeNS (undef, 'actual')) {        if ($node->hasAttributeNS (undef, 'actual')) {
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24