summaryrefslogtreecommitdiff
path: root/test/DOMTSHandler.pm
diff options
context:
space:
mode:
Diffstat (limited to 'test/DOMTSHandler.pm')
-rw-r--r--test/DOMTSHandler.pm1541
1 files changed, 1541 insertions, 0 deletions
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 <comment> element
+ inline_comment => 0,
+ # The stack of elements encountered utill now
+ context => [],
+ # The map for <var> 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 <member> 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 <stdio.h>
+#include <string.h>
+#include <stdbool.h>
+
+#include <dom/dom.h>
+#include <dom/functypes.h>
+
+#include <domts.h>
+
+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 <var name="v" type="DOMString" value="some some"
+ if ($ats->{"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 <var> when the <var> 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
+ # <if> or <while>, 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 <if> element ended but not <else>
+ # The reason is that there may be no <else> element in <if> and
+ # we when there is an <else> element, it must nested in <if>. ^_^
+ 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
+#<assertEquals ..>
+# <stat1 />
+# <stat2 />
+#</assertEquals>
+#
+# 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;
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-20 00:42:20 +0000