# This is the PerSAX Handlers Package package DOMTSHandler; use Switch; use XML::XPath; use XML::XPath::XMLParser; our $description = 0; our $string_index = 0; our $ret_index = 0; our $condition_index = 0; our $test_index = 0; our $iterator_index = 0; our $temp_index = 0; # Sometimes, we need temp nodes our $tnode_index = 0; our $dom_feature = "\"XML\""; our %bootstrap_api = ( dom_implementation_create_document_type => "", dom_implementation_create_document => "", ); our %native_interface = ( DOMString => \&generate_domstring_interface, DOMTimeStamp => "", DOMUserData => "", DOMObject =>"", ); our %special_type = ( # Some of the type are not defined now! boolean => "bool ", int => "int32_t ", "unsigned long" => "uint32_t ", DOMString => "dom_string *", List => "list *", Collection => "list *", DOMImplementation => "dom_implementation *", NamedNodeMap => "dom_namednodemap *", NodeList => "dom_nodelist *", HTMLCollection => "dom_html_collection *", HTMLFormElement => "dom_html_form_element *", CharacterData => "dom_characterdata *", CDATASection => "dom_cdata_section *", ); our %special_prefix = ( DOMString => "dom_string", DOMImplementation => "dom_implementation", NamedNodeMap => "dom_namednodemap", NodeList => "dom_nodelist", HTMLCollection => "dom_html_collection", HTMLFormElement => "dom_html_form_element", CharacterData => "dom_characterdata", CDATASection => "dom_cdata_section *", HTMLHRElement => "dom_html_hr_element", HTMLBRElement => "dom_html_br_element", ); our %unref_prefix = ( DOMString => "dom_string", NamedNodeMap => "dom_namednodemap", NodeList => "dom_nodelist", HTMLCollection => "dom_html_collection", ); our %special_method = ( ); our %special_attribute = ( namespaceURI => "namespace", ); our %no_unref = ( "boolean" => 1, "int" => 1, "unsigned int" => 1, "List" => 1, "Collection" => 1, ); our %override_suffix = ( boolean => "bool", int => "int", "unsigned long" => "unsigned_long", DOMString => "domstring", DOMImplementation => "domimplementation", NamedNodeMap => "domnamednodemap", NodeList => "domnodelist", HTMLCollection => "domhtmlcollection", Collection => "list", List => "list", ); our %exceptions = ( DOM_NO_ERR => 0, DOM_INDEX_SIZE_ERR => 1, DOM_DOMSTRING_SIZE_ERR => 2, DOM_HIERARCHY_REQUEST_ERR => 3, DOM_WRONG_DOCUMENT_ERR => 4, DOM_INVALID_CHARACTER_ERR => 5, DOM_NO_DATA_ALLOWED_ERR => 6, DOM_NO_MODIFICATION_ALLOWED_ERR => 7, DOM_NOT_FOUND_ERR => 8, DOM_NOT_SUPPORTED_ERR => 9, DOM_INUSE_ATTRIBUTE_ERR => 10, DOM_INVALID_STATE_ERR => 11, DOM_SYNTAX_ERR => 12, DOM_INVALID_MODIFICATION_ERR => 13, DOM_NAMESPACE_ERR => 14, DOM_INVALID_ACCESS_ERR => 15, DOM_VALIDATION_ERR => 16, DOM_TYPE_MISMATCH_ERR => 17, DOM_UNSPECIFIED_EVENT_TYPE_ERR => (1<<30)+0, DOM_DISPATCH_REQUEST_ERR => (1<<30)+1, DOM_NO_MEM_ERR => (1<<31)+0, ); our @condition = qw(same equals notEquals less lessOrEquals greater greaterOrEquals isNull notNull and or xor not instanceOf isTrue isFalse hasSize contentType hasFeature implementationAttribute); our @exception = qw(INDEX_SIZE_ERR DOMSTRING_SIZE_ERR HIERARCHY_REQUEST_ERR WRONG_DOCUMENT_ERR INVALID_CHARACTER_ERR NO_DATA_ALLOWED_ERR NO_MODIFICATION_ALLOWED_ERR NOT_FOUND_ERR NOT_SUPPORTED_ERR INUSE_ATTRIBUTE_ERR NAMESPACE_ERR UNSPECIFIED_EVENT_TYPE_ERR DISPATCH_REQUEST_ERR); our @assertion = qw(assertTrue assertFalse assertNull assertNotNull assertEquals assertNotEquals assertSame assertInstanceOf assertSize assertEventCount assertURIEquals); our @assertexception = qw(assertDOMException assertEventException assertImplementationException); our @control = qw(if while for-each else); our @framework_statement = qw(assign increment decrement append plus subtract mult divide load implementation comment hasFeature implementationAttribute EventMonitor.setUserObj EventMonitor.getAtEvents EventMonitor.getCaptureEvents EventMonitor.getBubbleEvents EventMonitor.getAllEvents wait); sub new { my $type = shift; my $dtd = shift; my $chdir = shift; my $dd = XML::XPath->new(filename => $dtd); my $self = { # The DTD file of the xml files dd => $dd, # To indicate whether we are in comments comment => 0, # To indicate that whether we are in element inline_comment => 0, # The stack of elements encountered utill now context => [], # The map for name => type var => {}, # See the comment on generate_condition2 for this member condition_stack => [], # The list for UNREF unref => [], string_unref => [], # The indent of current statement indent => "", # The variables for List/Collection # We now, declare an array for a list and then add them into a list # The map for all the List/Collection in one test # "List Name" => "Member type" list_map => {}, # The name of the current List/Collection list_name => "", # The number of items of the current List/Collection list_num => 0, # Whether List/Collection has members list_hasmem => 0, # The type of the current List/Collection list_type => "", # Whether we are in exception assertion exception => 0, # Where to chdir chdir => $chdir }; return bless $self, $type; } sub start_element { my ($self, $element) = @_; my $en = $element->{Name}; my $dd = $self->{dd}; my $ct = $self->{context}; push(@$ct, $en); switch ($en) { case "test" { ; } case "metadata" { # start comments here print "/*\n"; $self->{comment} = 1; } # Print the var definition case "var" { $self->generate_var($element->{Attributes}); } case "member" { if ($self->{context}->[-2] eq "var") { if ($self->{"list_hasmem"} eq 1) { print ", "; } $self->{"list_hasmem"} = 1; $self->{"list_num"} ++; } } # The framework statements case [@framework_statement] { # Because the implementationAttribute & hasFeature belongs to both # framework-statement and condition, we should distinct the two # situation here. Let the generate_condtion to do the work. if ($en eq "hasFeature" || $en eq "implementationAttribute") { next; } $self->generate_framework_statement($en, $element->{Attributes}); } case [@control] { $self->generate_control_statement($en, $element->{Attributes}); } # Test condition case [@condition] { $self->generate_condition($en, $element->{Attributes}); } # The assertsions case [@assertion] { $self->generate_assertion($en, $element->{Attributes}); } case [@assertexception] { # Indeed, nothing to do here! } # Deal with exception case [@exception] { # Just see end_element $self->{'exception'} = 1; } # Then catch other case else { # we don't care the comment nodes if ($self->{comment} eq 0) { $self->generate_interface($en, $element->{Attributes}); } } } } sub end_element { my ($self, $element) = @_; my @ct = @{$self->{context}}; my $name = pop(@{$self->{context}}); switch ($name) { case "metadata" { print "*/\n"; $self->{comment} = 0; $self->generate_main(); } case "test" { $self->cleanup(); } case "var" { $self->generate_list(); } # End of condition case [@condition] { $self->complete_condition($name); } # The assertion case [@assertion] { $self->complete_assertion($name); } case [@control] { $self->complete_control_statement($name); } case [@exception] { $name = "DOM_".$name; print "assert(exp == $exceptions{$name});\n"; $self->{'exception'} = 0; } } } sub characters { my ($self, $data) = @_; our $description; my $ct = $self->{context}; if ($self->{"inline_comment"} eq 1) { print "$data->{Data}"; return ; } # We print the comments here if ($self->{comment} eq 1) { # So, we are in comments state my $top = $ct->[$#{$ct}]; if ($top eq "metadata") { return; } if ($top eq "description") { if ($description eq 0) { print "description: \n"; $description = 1; } print "$data->{Data}"; } else { print "$top: $data->{Data}\n"; } return; } if ($self->{context}->[-1] eq "member") { # We should mark that the List/Collection has members $self->{"list_hasmem"} = 1; # Here, we should detect the characters type # whether it is a integer or string (now, we only take care # of the two types, because I did not find any other type). if ($self->{"list_type"} eq "") { if ($data->{Data} =~ /^\"/) { $self->{"list_type"} = "char *"; print "const char *".$self->{"list_name"}."Array[] = \{ $data->{Data}"; } else { if ($data->{Data} =~ /^[0-9]+/) { $self->{"list_type"} = "int *"; print "int ".$self->{"list_name"}."Array[] = \{ $data->{Data}"; } else { die "Some data in the we can't process: \"$data->{Data}\""; } } } else { # So, we must have known the type, just output the member print "$data->{Data}"; } } } sub generate_main { my $self = shift; # Firstly, push a new "b" to the string_unref list push(@{$self->{"string_unref"}}, "b"); print << "__EOF__" #include #include #include #include #include #include #include dom_implementation *doc_impl; int main(int argc, char **argv) { dom_exception exp; (void)argc; (void)argv; if (chdir("$self->{chdir}") < 0) { perror("chdir (\\"$self->{chdir})\\""); return 1; } __EOF__ } # Note that, we have not just declare variables here # we should also define EventListener here! # I think this should be done after the EventListener design # is complete sub generate_var { my ($self, $ats) = @_; my $type = ""; my $dstring = ""; # For the case like {"type"} eq "DOMString" and exists $ats->{"value"}) { $dstring = $self->generate_domstring($ats->{"value"}); $ats->{"value"} = $dstring; } $type = type_to_ctype($ats->{"type"}); if ($type eq "") { print "Not implement this type now\n"; return; } print "\t$type$ats->{'name'}"; if (exists $ats->{"value"}) { print " = $ats->{'value'};\n"; } else { if ($type =~ m/\*/) { print " = NULL;\n"; } else { print ";\n"; } } my $var = $self->{"var"}; $var->{$ats->{"name"}} = $ats->{"type"}; # If the type is List/Collection, we should take care of it if ($ats->{"type"} =~ /^(List|Collection)$/) { $self->{"list_name"} = $ats->{"name"}; } } sub generate_list { my $self = shift; # We should deal with the end of when the is declaring a List/Collection if ($self->{"list_hasmem"} eq 1) { # Yes, we are in List/Collection declaration # Firstly, enclose the Array declaration print "};\n"; # Now, we should create the list * for the List/Collection # Note, we should deal with "int" or "string" type with different params. if ($self->{"list_type"} eq "char *") { print $self->{"list_name"}." = list_new(STRING);\n"; } if ($self->{"list_type"} eq "int *") { print $self->{"list_name"}." = list_new(INT);\n"; } if ($self->{"list_type"} eq "") { die "A List/Collection has children member but no type is impossible!"; } for (my $i = 0; $i < $self->{"list_num"}; $i++) { # Use *(char **) to convert char *[] to char * print "list_add(".$self->{"list_name"}.", *(char **)(".$self->{"list_name"}."Array + $i));\n"; } } else { if ($self->{"list_name"} ne "") { #TODO: generally, we set the list type as dom_string, but it may be dom_node print $self->{"list_name"}." = list_new(DOM_STRING);\n"; $self->{"list_type"} = "DOMString"; } } # Add the List/Collection to map $self->{"list_map"}->{$self->{"list_name"}} = $self->{"list_type"}; # Reset the List/Collection member state $self->{"list_hasmem"} = 0; $self->{"list_name"} = ""; $self->{"list_type"} = ""; $self->{"list_num"} = 0; } sub generate_load { my ($self, $a) = @_; my %ats = %$a; my $doc = $ats{"var"}; $test_index ++; # define the test file path, use HTML if there is, otherwise using XML # Attention: I intend to copy the test files to the program excuting dir print "\tconst char *test$test_index = \"$ats{'href'}.html\";\n\n"; print "\t$doc = load_html(test$test_index, $ats{'willBeModified'});"; print "\tif ($doc == NULL) {\n"; $test_index ++; print "\t\tconst char *test$test_index = \"$ats{'href'}.xml\";\n\n"; print "\t\t$doc = load_xml(test$test_index, $ats{'willBeModified'});\n"; print "\t\tif ($doc == NULL)\n"; print "\t\t\treturn 1;\n"; print "\t\t}\n"; print << "__EOF__"; exp = dom_document_get_implementation($doc, &doc_impl); if (exp != DOM_NO_ERR) return exp; __EOF__ $self->addto_cleanup($doc); } sub generate_framework_statement { my ($self, $name, $ats) = @_; switch($name) { case "load" { $self->generate_load($ats); } case "assign" { my $var = $ats->{"var"}; my $value = "0"; if (exists $ats->{"value"}) { $value = $ats->{"value"}; } # Assign with strong-type-conversion, this is necessary in C. # And we may need to do deep-copy in the future. FIXME my $type = type_to_ctype($self->{"var"}->{$var}); print "$var = \($type\) $value;\n"; } case "increment" { my $var = $ats->{"var"}; my $value = $ats->{"value"}; print "$var += $value;\n"; } case "decrement" { my $var = $ats->{"var"}; my $value = $ats->{"value"}; print "$var -= $value;\n"; } case "append" { my $col = $ats->{"collection"}; my $obj = ""; # God, the DTD said, there should be a "OBJ" attribute, but there may not! if (exists $ats->{"obj"}) { $obj = $ats->{"obj"}; } else { $obj = $ats->{"item"} } if (not $self->{"var"}->{$col} =~ /^(List|Collection)/) { die "Append data to some non-list type!"; } print "list_add($col, $obj);\n"; } case [qw(plus subtract mult divide)] { my $var = $ats->{"var"}; my $op1 = $ats->{"op1"}; my $op2 = $ats->{"op2"}; my %table = ("plus", "+", "subtract", "-", "mult", "*", "divide", "/"); print "$var = $op1 $table{$name} $op2;\n"; } case "comment" { print "\*"; $self->{"inline_comment"} = 1; } case "implementation" { if (not exists $ats->{"obj"}) { my $var = $ats->{"var"}; my $dstring = generate_domstring($self, $dom_feature); print "exp = dom_implregistry_get_dom_implementation($dstring, \&$var);\n"; print "\tif (exp != DOM_NO_ERR) {\n"; $self->cleanup_fail("\t\t"); print "\t\treturn exp;\n\t}\n"; last; } my $obj = $ats->{"obj"}; my $var = $ats->{"var"}; # Here we directly output the libDOM's get_implementation API print "\texp = dom_document_get_implementation($obj, \&$var);\n"; print "\tif (exp != DOM_NO_ERR) {\n"; $self->cleanup_fail("\t\t"); print "\t\treturn exp;\n\t}\n"; } # We deal with hasFeaturn and implementationAttribute in the generate_condition case "hasFeature" { die "No, never can be here!"; } case "implementaionAttribute" { die "No, never can be here!"; } # Here, we die because we did not implement other statements # We did not implement these statements, because there are no use of them in the W3C DOMTS now case [@framework_statement] { die "The statement \"$name\" is not implemented yet!"; } } } sub complete_framework_statement { my ($self, $name) = @_; switch($name) { case "comment" { print "*/\n"; $self->{"inline_comment"} = 0; } } } sub generate_interface { my ($self, $en, $a) = @_; my %ats = %$a; my $dd = $self->{dd}; if (exists $ats{'interface'}) { # Firstly, test whether it is a DOM native interface if (exists $native_interface{$ats{'interface'}}) { if ($native_interface{$ats{'interface'}} eq "") { die "Unkown how to deal with $en of $ats{'interface'}"; } return $native_interface{$ats{'interface'}}($self, $en, $a); } my $ns = $dd->find("/library/interface[\@name=\"$ats{'interface'}\"]/method[\@name=\"$en\"]"); if ($ns->size() != 0) { my $node = $ns->get_node(1); $self->generate_method($en, $node, %ats); } else { my $ns = $dd->find("/library/interface[\@name=\"$ats{'interface'}\"]/attribute[\@name=\"$en\"]"); if ($ns->size() != 0) { my $node = $ns->get_node(1); $self->generate_attribute_accessor($en, $node, %ats); } } } else { my $ns = $dd->find("/library/interface/method[\@name=\"$en\"]"); if ($ns->size() != 0) { my $node = $ns->get_node(1); $self->generate_method($en, $node, %ats); } else { my $ns = $dd->find("/library/interface/attribute[\@name=\"$en\"]"); if ($ns->size() != 0) { my $node = $ns->get_node(1); $self->generate_attribute_accessor($en, $node, %ats); } else { die "Oh, Can't find how to deal with the element $en\n"; } } } } sub generate_method { my ($self, $en, $node, %ats) = @_; my $dd = $self->{dd}; if (! exists $ats{'interface'}) { my $n = $node; while($n->getLocalName() ne "interface") { $n = $n->getParentNode(); } $ats{'interface'} = $n->getAttribute("name"); } $method = to_cmethod($ats{'interface'}, $en); my $cast = to_attribute_cast($ats{'interface'}); my $ns = $dd->find("parameters/param", $node); my $params = "${cast}$ats{'obj'}"; for ($count = 1; $count <= $ns->size; $count++) { my $n = $ns->get_node($count); my $p = $n->getAttribute("name"); my $t = $n->getAttribute("type"); # Change the raw string and the char * to dom_string if ($t eq "DOMString") { if ($ats{$p} =~ /^"/ or $self->{"var"}->{$ats{$p}} eq "char *") { $self->generate_domstring($ats{$p}); $params = $params.", dstring$string_index"; next; } } # For the case that the testcase did not provide the param, we just pass a NULL # Because we are in C, not like C++ which can overriden functions if (not exists $ats{$p}) { $params = $params.", NULL"; next; } $params = $params.", $ats{$p}"; } #$ns = $dd->find("returns", $node); #my $n = $ns->get_node(1); #my $t = $n->getAttribute("type"); # declare the return value #my $tp = type_to_ctype($t); #print "\t$tp ret$ret_index;\n"; my $unref = 0; my $temp_node = 0; if (exists $ats{'var'}) { # Add the bootstrap params if (exists $bootstrap_api{$method}) { if ($method eq "dom_implementation_create_document") { $params = $params.", myrealloc, NULL, NULL"; } else { $params = $params.", myrealloc, NULL"; } } # Deal with the situation like # # dom_node_append_child(node, new_node, &node); # # Here, we should import a tempNode, and change this expression to # # dom_node *tnode1 = NULL; # dom_node_append_child(node, new_node, &tnode1); # dom_node_unref(node); # node = tnode1; # # Over. if ($ats{'obj'} eq $ats{'var'}) { my $t = type_to_ctype($self->{'var'}->{$ats{'var'}}); $tnode_index ++; print "$t tnode$tnode_index = NULL;"; $params = $params.", \&tnode$tnode_index"; # The ats{'obj'} must have been added to cleanup stack $unref = 1; # Indicate that we have created a temp node $temp_node = 1; } else { $params = $params.", (void *) \&$ats{'var'}"; $unref = $self->param_unref($ats{'var'}); } } print "\texp = $method($params);\n"; if ($self->{'exception'} eq 0) { print << "__EOF__"; if (exp != DOM_NO_ERR) { fprintf(stderr, "Exception raised from %s\\n", "$method"); __EOF__ $self->cleanup_fail("\t\t"); print << "__EOF__"; return exp; } __EOF__ } if (exists $ats{'var'} and $unref eq 0) { $self->addto_cleanup($ats{'var'}); } if ($temp_node eq 1) { my $t = $self->{'var'}->{$ats{'var'}}; if (not exists $no_unref{$t}) { my $prefix = "dom_node"; if (exists $unref_prefix{$t}) { $prefix = $unref_prefix{$t}; } print $prefix."_unref(".$ats{'obj'}.");\n"; } print "$ats{'var'} = tnode$tnode_index;"; } } sub generate_attribute_accessor { my ($self, $en, $node, %ats) = @_; if (defined($ats{'var'})) { generate_attribute_fetcher(@_); } else { if (defined($ats{'value'})) { generate_attribute_setter(@_); } } } sub generate_attribute_fetcher { my ($self, $en, $node, %ats) = @_; my $dd = $self->{dd}; if (! exists $ats{'interface'}) { my $n = $node; while($n->getLocalName() ne "interface") { $n = $n->getParentNode(); } $ats{'interface'} = $n->getAttribute("name"); } my $fetcher = to_attribute_fetcher($ats{'interface'}, "$en"); my $cast = to_attribute_cast($ats{'interface'}); my $unref = 0; my $temp_node = 0; # Deal with the situation like # # dom_node_get_next_sibling(child, &child); # # Here, we should import a tempNode, and change this expression to # # dom_node *tnode1 = NULL; # dom_node_get_next_sibling(child, &tnode1); # dom_node_unref(child); # child = tnode1; # # Over. if ($ats{'obj'} eq $ats{'var'}) { my $t = type_to_ctype($self->{'var'}->{$ats{'var'}}); $tnode_index ++; print "\t$t tnode$tnode_index = NULL;\n"; print "\texp = $fetcher(${cast}$ats{'obj'}, \&tnode$tnode_index);\n"; # The ats{'obj'} must have been added to cleanup stack $unref = 1; # Indicate that we have created a temp node $temp_node = 1; } else { $unref = $self->param_unref($ats{'var'}); print "\texp = $fetcher(${cast}$ats{'obj'}, \&$ats{'var'});\n"; } if ($self->{'exception'} eq 0) { print << "__EOF__"; if (exp != DOM_NO_ERR) { fprintf(stderr, "Exception raised when fetch attribute %s", "$en"); __EOF__ $self->cleanup_fail("\t\t"); print << "__EOF__"; return exp; } __EOF__ } if ($temp_node eq 1) { my $t = $self->{'var'}->{$ats{'var'}}; if (not exists $no_unref{$t}) { my $prefix = "dom_node"; if (exists $unref_prefix{$t}) { $prefix = $unref_prefix{$t}; } print $prefix."_unref(".$ats{'obj'}.");\n"; } print "$ats{'var'} = tnode$tnode_index;"; } if ($unref eq 0) { $self->addto_cleanup($ats{'var'}); } } sub generate_attribute_setter { my ($self, $en, $node, %ats) = @_; my $dd = $self->{dd}; if (! exists $ats{'interface'}) { my $n = $node; while($n->getLocalName() ne "interface") { $n = $n->getParentNode(); } $ats{'interface'} = $n->getAttribute("name"); } my $setter = to_attribute_setter($ats{'interface'}, "$en"); my $param = "$ats{'obj'}"; # For DOMString, we should deal specially my $lp = $ats{'value'}; if ($node->getAttribute("type") eq "DOMString") { if ($ats{'value'} =~ /^"/ or $self->{"var"}->{$ats{'value'}} eq "char *") { $lp = $self->generate_domstring($ats{'value'}); } } $param = $param.", $lp"; print "exp = $setter($param);"; if ($self->{'exception'} eq 0) { print << "__EOF__"; if (exp != DOM_NO_ERR) { fprintf(stderr, "Exception raised when fetch attribute %s", "$en"); __EOF__ $self->cleanup_fail("\t\t"); print << "__EOF__"; return exp; } __EOF__ } } sub generate_condition { my ($self, $name, $ats) = @_; # If we are in nested or/and/xor/not, we should put a operator before test my @array = @{$self->{condition_stack}}; if ($#array ge 0) { switch ($array[-1]) { case "xor" { print " ^ "; } case "or" { print " || "; } case "and" { print " && "; } # It is the indicator, just pop it. case "new" { pop(@{$self->{condition_stack}}); } } } switch ($name) { case [qw(less lessOrEquals greater greaterOrEquals)] { my $actual = $ats->{actual}; my $expected = $ats->{expected}; my $method = $name; $method =~ s/[A-Z]/_$&/g; $method = lc $method; print "$method($expected, $actual)"; } case "same" { my $actual = $ats->{actual}; my $expected = $ats->{expected}; my $func = $self->find_override("is_same", $actual, $expected); print "$func($expected, $actual)"; } case [qw(equals notEquals)]{ my $actual = $ats->{actual}; my $expected = $ats->{expected}; my $ig; if (exists $ats->{ignoreCase}){ $ig = $ats->{ignoreCase}; } else { $ig = "false"; } $ig = adjust_ignore($ig); my $func = $self->find_override("is_equals", $actual, $expected); if ($name =~ /not/i){ print "(false == $func($expected, $actual, $ig))"; } else { print "$func($expected, $actual, $ig)"; } } case [qw(isNull notNull)]{ my $obj = $ats->{obj}; if ($name =~ /not/i) { print "(false == is_null($obj))"; } else { print "is_null($obj)"; } } case "isTrue" { my $value = $ats->{value}; print "is_true($value)"; } case "isFalse" { my $value = $ats->{value}; print "(false == is_true($value))"; } case "hasSize" { my $obj = $ats->{obj}; my $size = $ats->{expected}; my $func = $self->find_override("is_size", $obj, $size); print "$func($size, $obj)"; } case "contentType" { my $type = $ats->{type}; print "is_contenttype(\"$type\")"; } case "instanceOf" { my $obj = $ats->{obj}; my $type = $ats->{type}; print "instanceOf(\"$type\", $obj)"; } case "hasFeature" { if (exists $ats->{var}) { $self->generate_interface($name, $ats); } else { my $feature = $ats->{feature}; if (not ($feature =~ /^"/)) { $feature = '"'.$feature.'"'; } my $version = "NULL"; if (exists $ats->{version}) { $version = $ats->{version}; if (not ($version =~ /^"/)) { $version = '"'.$version.'"'; } } if ($self->{context}->[-2] ne "condition") { # we are not in a %condition place, so we must be a statement # we change this to assert # print "assert(has_feature($feature, $version));\n" # do nothing if we are not in condition. } else { print "has_feature($feature, $version)"; } } } case "implementationAttribute" { my $value = $ats->{value}; my $name = $ats->{name}; if ($self->{context}->[-2] ne "condition") { # print "assert(implementation_attribute(\"$name\", $value));"; # Do nothing, and the same with hasFeature, this means we will # run all test cases now and try to get a result whether we support # such feature. } else { print "implementation_attribute(\"$name\", $value)"; } } case [qw(and or xor)] { push(@{$self->{condition_stack}}, $name); push(@{$self->{condition_stack}}, "new"); print "("; } case "not" { push(@{$self->{condition_stack}}, $name); print "(false == "; } } } sub complete_condition { my ($self, $name) = @_; if ($name =~ /^(xor|or|and)$/i) { print ")"; my $top = pop(@{$self->{condition_stack}}); die "Condition stack error! $top != $name" if $top ne $name; } if ($name eq "not") { my $top = pop(@{$self->{condition_stack}}); die "Condition stack error! $top != $name" if $top ne $name; print ")"; } # we deal with the situation that the %condition is in a control statement such as # or , and we should start a new '{' block here if ($self->{context}->[-1] eq "condition") { print ") {\n"; pop(@{$self->{context}}); } } sub generate_assertion { my ($self, $name, $ats) = @_; print "\tassert("; switch($name){ # Only assertTrue & assertFalse can have nested %conditions case [qw(assertTrue assertFalse assertNull)] { my $n = $name; $n =~ s/assert/is/g; if (exists $ats->{actual}){ my $ta = { value => $ats->{actual}, obj => $ats->{actual}}; $self->generate_condition($n,$ta); } } case [qw(assertNotNull assertEquals assertNotEquals assertSame)] { my $n = $name; $n =~ s/assert//g; $n = lcfirst $n; if (exists $ats->{actual}){ my $ta = { actual => $ats->{actual}, value => $ats->{actual}, obj => $ats->{actual}, expected => $ats->{expected}, ignoreCase => $ats->{ignoreCase}, type => $ats->{type}, }; $self->generate_condition($n,$ta); } } case "assertInstanceOf" { my $obj = $ats->{obj}; my $type = $ats->{type}; print "is_instanceof(\"$type\", $obj)"; } case "assertSize" { my $n = $name; $n =~ s/assert/has/; if (exists $ats->{collection}){ my $ta = { obj => $ats->{collection}, expected => $ats->{size}}; $self->generate_condition($n,$ta); } } case "assertEventCount" { #todo } case "assertURIEquals" { my $actual = $ats->{actual}; my ($scheme, $path, $host, $file, $name, $query, $fragment, $isAbsolute) = qw(NULL NULL NULL NULL NULL NULL NULL NULL); if (exists $ats->{scheme}) { $scheme = $ats->{scheme}; } if (exists $ats->{path}) { $path = $ats->{path}; } if (exists $ats->{host}) { $host = $ats->{host}; } if (exists $ats->{file}) { $file = $ats->{file}; } if (exists $ats->{name}) { $name = $ats->{name}; } if (exists $ats->{query}) { $query = $ats->{query}; } if (exists $ats->{fragment}) { $fragment = $ats->{fragment}; } if (exists $ats->{isAbsolute}) { $isAbsolute = $ats->{isAbsolute}; } print "is_uri_equals($scheme, $path, $host, $file, $name, $query, $fragment, $isAbsolute, $actual)" } } } sub complete_assertion { my ($self, $name) = @_; print ");\n"; } sub generate_control_statement { my ($self, $name, $ats) = @_; switch($name) { case "if" { print "\tif("; push(@{$self->{"context"}}, "condition"); } case "else" { $self->cleanup_block_domstring(); print "\t} else {"; } case "while" { print "\twhile ("; push(@{$self->{"context"}}, "condition"); } case "for-each" { # Detect what is the collection type, if it is "string", we # should also do some conversion work my $coll = $ats->{"collection"}; # The default member type is dom_node my $type = "dom_node *"; if (exists $self->{"list_map"}->{$coll}) { $type = $self->{"list_map"}->{$coll}; } # Find the member variable, if it is not declared before, declare it firstly my $member = $ats->{"member"}; if (not exists $self->{"var"}->{$member}) { print "$type $member;\n"; # Add the new variable to the {var} map $self->{"var"}->{"$member"} = $type; } # Now the member is conformed to be declared if ($self->{"var"}->{$coll} =~ /^(List|Collection)$/) { # The element in the list is not equal with the member object # For now, there is only one case for this, it is "char *" <=> "DOMString" my $conversion = 0; if ($self->{"var"}->{"$member"} ne $type) { if ($self->{"var"}->{"$member"} eq "DOMString") { if ($type eq "char *") { $conversion = 1; } } } $iterator_index++; print "unsigned int iterator$iterator_index = 0;"; if ($conversion eq 1) { print "char *tstring$temp_index = NULL;"; } print "foreach_initialise_list($coll, \&iterator$iterator_index);\n"; print "while(get_next_list($coll, \&iterator$iterator_index, "; if ($conversion eq 1) { print "\&tstring$temp_index)) {\n"; print "exp = dom_string_create((const uint8_t *)tstring$temp_index,"; print "strlen(tstring$temp_index), &$member);\n"; print "if (exp != DOM_NO_ERR) {\n"; print "\t\tfprintf(stderr, \"Can't create DOMString\\n\");"; $self->cleanup_fail("\t\t"); print "\t\treturn exp;\n\t}\n"; $temp_index ++; } else { print "\&$member)) {\n"; } } if ($self->{"var"}->{$coll} eq "NodeList") { $iterator_index++; print "unsigned int iterator$iterator_index = 0;"; print "foreach_initialise_domnodelist($coll, \&iterator$iterator_index);\n"; print "while(get_next_domnodelist($coll, \&iterator$iterator_index, \&$member)) {\n"; } if ($self->{"var"}->{$coll} eq "NamedNodeMap") { $iterator_index++; print "unsigned int iterator$iterator_index = 0;"; print "foreach_initialise_domnamednodemap($coll, \&iterator$iterator_index);\n"; print "while(get_next_domnamednodemap($coll, \&iterator$iterator_index, \&$member)) {\n"; } if ($self->{"var"}->{$coll} eq "HTMLCollection") { $iterator_index++; print "unsigned int iterator$iterator_index = 0;"; print "foreach_initialise_domhtmlcollection($coll, \&iterator$iterator_index);\n"; print "while(get_next_domhtmlcollection($coll, \&iterator$iterator_index, \&$member)) {\n"; } } } # Firstly, we enter a new block, so push a "b" into the string_unref list push(@{$self->{"string_unref"}}, "b"); } sub complete_control_statement { my ($self, $name) = @_; # Note: we only print a '}' when element ended but not # The reason is that there may be no element in and # we when there is an element, it must nested in . ^_^ switch($name) { case [qw(if while for-each)] { # Firstly, we should cleanup the dom_string in this block $self->cleanup_block_domstring(); print "}\n"; } } } ############################################################################### # # The helper functions # sub generate_domstring { my ($self, $str) = @_; $string_index = $string_index + 1; print << "__EOF__"; const char *string$string_index = $str; dom_string *dstring$string_index; exp = dom_string_create((const uint8_t *)string$string_index, strlen(string$string_index), &dstring$string_index); if (exp != DOM_NO_ERR) { fprintf(stderr, "Can't create DOMString\\n"); __EOF__ $self->cleanup_fail("\t\t"); print << "__EOF__"; return exp; } __EOF__ push(@{$self->{string_unref}}, "$string_index"); return "dstring$string_index"; } sub cleanup_domstring { my ($self, $indent) = @_; for (my $i = 0; $i <= $#{$self->{string_unref}}; $i++) { if ($self->{string_unref}->[$i] ne "b") { print $indent."dom_string_unref(dstring$self->{string_unref}->[$i]);\n"; } } } sub cleanup_block_domstring { my $self = shift; while ((my $num = pop(@{$self->{string_unref}})) ne "b" and $#{$self->{string_unref}} ne -1) { print "dom_string_unref(dstring$num);\n"; } } sub type_to_ctype { my $type = shift; if (exists $special_type{$type}) { return $special_type{$type}; } # If the type is not specially treated, we can transform it by rules if ($type =~ m/^HTML/) { # Don't deal with this now return ""; } # The core module comes here $type =~ s/[A-Z]/_$&/g; $type = lc $type; # For events module $type =~ s/_u_i_/_ui_/g; return "dom".$type." *"; } sub to_cmethod { my ($type, $m) = @_; my $prefix = get_prefix($type); my $ret; if (exists $special_method{$m}) { $ret = $prefix."_".$special_method{$m}; } else { $m =~ s/[A-Z]/_$&/g; $m = lc $m; $ret = $prefix."_".$m; } $ret =~ s/h_t_m_l/html/; $ret =~ s/c_d_a_t_a/cdata/; $ret =~ s/_n_s$/_ns/; # For DOMUIEvent $ret =~ s/_u_i_/_ui_/; # For initEvent $ret =~ s/init_event/init/; return $ret; } sub to_attribute_fetcher { return to_attribute_accessor(@_, "get"); } sub to_attribute_setter { return to_attribute_accessor(@_, "set"); } sub to_attribute_accessor { my ($type, $af, $accessor) = @_; my $prefix = get_prefix($type); my $ret; if (exists $special_attribute{$af}) { $ret = $prefix."_".$accessor."_".$special_attribute{$af}; } else { $af =~ s/[A-Z]/_$&/g; $af = lc $af; $ret = $prefix."_".$accessor."_".$af; } $ret =~ s/h_t_m_l/html/; return $ret; } sub to_attribute_cast { my $type = shift; my $ret = get_prefix($type); $ret =~ s/h_t_m_l/html/; return "(${ret} *)"; } sub get_prefix { my $type = shift; if (exists $special_prefix{$type}) { $prefix = $special_prefix{$type}; } else { $type =~ s/[A-Z]/_$&/g; $prefix = lc $type; $prefix = "dom".$prefix; } return $prefix; } # This function remain unsed sub get_suffix { my $type = shift; my $suffix = "default"; if (exists $override_suffix{$type}) { $suffix = $override_suffix{$type}; } else { $type =~ s/[A-Z]/_$&/g; $suffix = lc $type; $suffix = "dom".$suffix; } return $suffix; } #asserttions sometimes can contain sub-statements according the DTD. Like # # # # # # And assertion can contains assertions too! So, I use the assertion_stack # to deal: # # when we encounter an assertion, we push $assertionName, "end", "start" to # the stack, and when we encounter a statement, we examine the stack to see # the top element, if it is: # # 1. "start", then we are in sub-statement of that assertion, and this is the # the first sub-statement, so we should print a if (condtion==true) {, before # print the real statement. # 2. "end", then we are in sub-statement of that assertion, and we are not the # first one, just print the statement. # # But after searching the whole testcases, I found no use of sub-statements of assertions. # So, this function left unsed! sub end_half_assertion { my ($self, $name) = @_; my $top = pop(@{$self->{assertion_stack}}); if ($top eq "end") { print "$self->{indent}"."}\n"; } else { if ($top eq "start") { pop(@{$self->{assertion_stack}}); pop(@{$self->{assertion_stack}}); } } pop(@{$self->{assertion_stack}}); } ### Enclose an unsed function ############################################################################################## sub cleanup_domvar { my ($self, $indent) = @_; my $str = join($indent, reverse @{$self->{unref}}); print $indent.$str."\n"; } sub cleanup_fail { my ($self, $indent) = @_; $self->cleanup_domstring($indent); $self->cleanup_domvar($indent); } sub cleanup { my $self = shift; print "\n\n"; $self->cleanup_domstring("\t"); $self->cleanup_domvar("\t"); print "\n\tprintf(\"PASS\");\n"; print "\n\treturn 0;\n"; print "\n\}\n"; } sub addto_cleanup { my ($self, $var) = @_; my $type = $self->{'var'}->{$var}; if (not exists $no_unref{$type}) { my $prefix = "dom_node"; if (exists $unref_prefix{$type}) { $prefix = $unref_prefix{$type}; } push(@{$self->{unref}}, $prefix."_unref(".$var.");\n"); } } sub adjust_ignore { my $ig = shift; if ($ig eq "auto"){ return "true"; } return $ig; } sub find_override { my ($self, $func, $var, $expected) = @_; my $vn = $self->{var}->{$var}; # Deal with string types if ($expected eq "DOMString") { return $func."_domstring"; } else { if ($expected =~ /^\"/ or $self->{"var"}->{$expected} eq "char *") { return $func."_string"; } } if (exists $override_suffix{$vn}) { $func = $func."_".$override_suffix{$vn} } return $func; } sub param_unref { my ($self, $var) = @_; my $type = $self->{'var'}->{$var}; if (not exists $no_unref{$type}) { my $prefix = "dom_node"; if (exists $unref_prefix{$type}) { $prefix = $unref_prefix{$type}; } print "\tif ($var != NULL) {\n"; print "\t\t" . $prefix."_unref(".$var.");\n"; print "\t\t$var = NULL;\n"; print "\t}\n"; } foreach my $item (@{$self->{unref}}) { $item =~ m/.*\((.*)\).*/; if ($var eq $1) { return 1; } } foreach my $item (@{$self->{string_unref}}) { if ($var eq $item) { return 1; } } return 0; } sub generate_domstring_interface { my ($self, $en, $a) = @_; switch ($en) { case "length" { print "$a->{'var'} = dom_string_length($a->{'obj'});"; } else { die "Can't generate method/attribute $en for DOMString"; } } } 1;