mirror of
https://github.com/KolibriOS/kolibrios.git
synced 2024-12-17 20:32:35 +03:00
1583 lines
38 KiB
Perl
1583 lines
38 KiB
Perl
# 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 *",
|
|
);
|
|
|
|
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 <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,
|
|
# 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 <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 <unistd.h>
|
|
|
|
#include <dom/dom.h>
|
|
#include <dom/functypes.h>
|
|
|
|
#include <domts.h>
|
|
|
|
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 <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;\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 <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 "\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
|
|
# <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, $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 <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((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
|
|
#<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, 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;
|