From aba54ed61e31df318abdfa165f971a11ce084608 Mon Sep 17 00:00:00 2001 From: Bo Yang Date: Tue, 11 Aug 2009 11:17:23 +0000 Subject: Merge the branches/struggleyb/libdom-remain back to trunk. svn path=/trunk/dom/; revision=9191 --- test/DOMTSHandler.pm | 1541 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1541 insertions(+) create mode 100644 test/DOMTSHandler.pm (limited to 'test/DOMTSHandler.pm') diff --git a/test/DOMTSHandler.pm b/test/DOMTSHandler.pm new file mode 100644 index 0000000..c7dd61d --- /dev/null +++ b/test/DOMTSHandler.pm @@ -0,0 +1,1541 @@ +# 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 => "unsigned long ", + "unsigned long" => "unsigned long ", + DOMString => "dom_string *", + List => "list *", + Collection => "list *", + DOMImplementation => "dom_implementation *", + NamedNodeMap => "dom_namednodemap *", + NodeList => "dom_nodelist *", + CharacterData => "dom_characterdata *", + CDATASection => "dom_cdata_section *", +); +our %special_prefix = ( + DOMString => "dom_string", + DOMImplementation => "dom_implementation", + NamedNodeMap => "dom_namednodemap", + NodeList => "dom_nodelist", + CharacterData => "dom_characterdata", + CDATASection => "dom_cdata_section *", +); + +our %unref_prefix = ( + DOMString => "dom_string", + NamedNodeMap => "dom_namednodemap", + NodeList => "dom_nodelist", +); + +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", + 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_NO_MEM_ERR => (1<<16) +); + +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); + +our @assertion = qw(assertTrue assertFalse assertNull assertNotNull assertEquals assertNotEquals assertSame assertInstanceOf assertSize assertEventCount assertURIEquals); + +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 $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, + + }; + + 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 "assertDOMException" { + # 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 "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 + +dom_implementation *doc_impl; +lwc_context *ctx; + +int main(int argc, char **argv) +{ + dom_exception exp; + lwc_error lerr; + + /* Firstly, initialise dom and dom implementations */ + exp = dom_initialise(myrealloc, NULL); + if (exp != DOM_NO_ERR) + return exp; + + lerr = lwc_create_context(myrealloc, NULL, &ctx); + if (lerr != lwc_error_ok) + 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;"; + } 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 "\tchar *test$test_index = \"$ats{'href'}.html\";\n\n"; + print "$doc = load_html(test$test_index, $ats{'willBeModified'});"; + print "if ($doc == NULL) {"; + $test_index ++; + print " char *test$test_index = \"$ats{'href'}.xml\";\n\n"; + print " $doc = load_xml(test$test_index, $ats{'willBeModified'});"; + print " if ($doc == NULL)"; + print " return 1;"; + print "}"; + 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);"; + print "if (exp != DOM_NO_ERR) {"; + $self->cleanup_fail("\t\t"); + print "return exp;}"; + last; + } + + my $obj = $ats->{"obj"}; + my $var = $ats->{"var"}; + # Here we directly output the libDOM's get_implementation API + print "exp = dom_document_get_implementation($obj, \&$var);"; + print "if (exp != DOM_NO_ERR) {"; + $self->cleanup_fail("\t\t"); + print "return exp;}"; + } + + # 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 $ns = $dd->find("parameters/param", $node); + my $params = "$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}) { + $params = $params.", myrealloc, NULL, ctx"; + } + # 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 "exp = $method($params);"; + + 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 $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 tnode$tnode_index = NULL;"; + print "exp = $fetcher($ats{'obj'}, \&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 { + $unref = $self->param_unref($ats{'var'}); + print "exp = $fetcher($ats{'obj'}, \&$ats{'var'});"; + } + + + 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, $query, $fragment, $isAbsolute) = qw(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->{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, $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(myrealloc, NULL, (const uint8_t *)tstring$temp_index,"; + print "strlen(tstring$temp_index), &$member);"; + print "if (exp != DOM_NO_ERR) {"; + print "fprintf(stderr, \"Can't create DOMString\\n\");"; + $self->cleanup_fail("\t\t"); + print "return exp; }"; + $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"; + } + } + } + + # 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(myrealloc, NULL, (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; + 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/; + 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 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, @{$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\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 "if ($var != NULL) {"; + print $prefix."_unref(".$var.");\n"; + print "$var = NULL;"; + print "}"; + } + + 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; -- cgit v1.2.3