$VERSION = '0.01';
@ISA = qw(Exporter);
@EXPORT = qw(GetPrevLevel GetNextLevel ContainsDeferred ContainsString);
-@EXPORT_OK = qw(GetElementLevelTable ParseElement ValidElement);
+@EXPORT_OK = qw(GetElementLevelTable ParseElement ValidElement align_type mapToScalar ParseType can_contain_deferred);
use strict;
use Parse::Pidl qw(warning fatal);
my $is_varying = 0;
my $is_conformant = 0;
my $is_string = 0;
+ my $is_fixed = 0;
+ my $is_inline = 0;
if ($d eq "*") {
$is_conformant = 1;
}
}
+ $is_fixed = 1 if (not $is_conformant and Parse::Pidl::Util::is_constant($size));
+ $is_inline = 1 if (not $is_conformant and not Parse::Pidl::Util::is_constant($size));
+
push (@$order, {
TYPE => "ARRAY",
SIZE_IS => $size,
LENGTH_IS => $length,
- IS_DEFERRED => "$is_deferred",
- IS_SURROUNDING => "$is_surrounding",
- IS_ZERO_TERMINATED => "$is_string",
- IS_VARYING => "$is_varying",
- IS_CONFORMANT => "$is_conformant",
- IS_FIXED => (not $is_conformant and Parse::Pidl::Util::is_constant($size)),
- IS_INLINE => (not $is_conformant and not Parse::Pidl::Util::is_constant($size))
+ IS_DEFERRED => $is_deferred,
+ IS_SURROUNDING => $is_surrounding,
+ IS_ZERO_TERMINATED => $is_string,
+ IS_VARYING => $is_varying,
+ IS_CONFORMANT => $is_conformant,
+ IS_FIXED => $is_fixed,
+ IS_INLINE => $is_inline
});
}
if ($array_size or $is_string) {
push (@$order, {
TYPE => "ARRAY",
- IS_ZERO_TERMINATED => "$is_string",
SIZE_IS => $array_size,
LENGTH_IS => $array_length,
- IS_DEFERRED => "$is_deferred",
+ IS_DEFERRED => $is_deferred,
IS_SURROUNDING => 0,
- IS_VARYING => "$is_varying",
- IS_CONFORMANT => "$is_conformant",
+ IS_ZERO_TERMINATED => $is_string,
+ IS_VARYING => $is_varying,
+ IS_CONFORMANT => $is_conformant,
IS_FIXED => 0,
- IS_INLINE => 0,
+ IS_INLINE => 0
});
$is_deferred = 0;
}
if (scalar(@size_is) > 0) {
- warning($e, "size_is() on non-array element");
+ fatal($e, "size_is() on non-array element");
}
if (scalar(@length_is) > 0) {
- warning($e, "length_is() on non-array element");
+ fatal($e, "length_is() on non-array element");
}
if (has_property($e, "string")) {
- warning($e, "string() attribute on non-array element");
+ fatal($e, "string() attribute on non-array element");
}
push (@$order, {
TYPE => "DATA",
- CONVERT_TO => has_property($e, ""),
- CONVERT_FROM => has_property($e, ""),
DATA_TYPE => $e->{TYPE},
IS_DEFERRED => $is_deferred,
- CONTAINS_DEFERRED => can_contain_deferred($e),
+ CONTAINS_DEFERRED => can_contain_deferred($e->{TYPE}),
IS_SURROUNDING => 0 #FIXME
});
#####################################################################
# see if a type contains any deferred data
-sub can_contain_deferred
+sub can_contain_deferred($)
{
- my $e = shift;
+ sub can_contain_deferred($);
+ my ($type) = @_;
+
+ return 1 unless (hasType($type)); # assume the worst
- return 0 if (Parse::Pidl::Typelist::is_scalar($e->{TYPE}));
- return 1 unless (hasType($e->{TYPE})); # assume the worst
+ $type = getType($type);
- my $type = getType($e->{TYPE});
+ return 0 if (Parse::Pidl::Typelist::is_scalar($type));
- foreach my $x (@{$type->{DATA}->{ELEMENTS}}) {
- return 1 if ($x->{POINTERS});
- return 1 if (can_contain_deferred ($x));
+ return can_contain_deferred($type->{DATA}) if ($type->{TYPE} eq "TYPEDEF");
+
+ return 0 unless defined($type->{ELEMENTS});
+
+ foreach (@{$type->{ELEMENTS}}) {
+ return 1 if ($_->{POINTERS});
+ return 1 if (can_contain_deferred ($_->{TYPE}));
}
return 0;
sub align_type($)
{
sub align_type($);
- my $e = shift;
+ my ($e) = @_;
+
+ if (ref($e) eq "HASH" and $e->{TYPE} eq "SCALAR") {
+ return $scalar_alignment->{$e->{NAME}};
+ }
+
+ return 0 if ($e eq "EMPTY");
unless (hasType($e)) {
# it must be an external type - all we can do is guess
- # print "Warning: assuming alignment of unknown type '$e' is 4\n";
+ # warning($e, "assuming alignment of unknown type '$e' is 4");
return 4;
}
- my $dt = getType($e)->{DATA};
+ my $dt = getType($e);
- if ($dt->{TYPE} eq "ENUM") {
+ if ($dt->{TYPE} eq "TYPEDEF") {
+ return align_type($dt->{DATA});
+ } elsif ($dt->{TYPE} eq "ENUM") {
return align_type(Parse::Pidl::Typelist::enum_type_fn($dt));
} elsif ($dt->{TYPE} eq "BITMAP") {
return align_type(Parse::Pidl::Typelist::bitmap_type_fn($dt));
} elsif (($dt->{TYPE} eq "STRUCT") or ($dt->{TYPE} eq "UNION")) {
+ # Struct/union without body: assume 4
+ return 4 unless (defined($dt->{ELEMENTS}));
return find_largest_alignment($dt);
- } elsif ($dt->{TYPE} eq "SCALAR") {
- return $scalar_alignment->{$dt->{NAME}};
}
die("Unknown data type type $dt->{TYPE}");
}
-sub ParseElement($)
+sub ParseElement($$)
{
- my $e = shift;
+ my ($e, $pointer_default) = @_;
$e->{TYPE} = expandAlias($e->{TYPE});
+ if (ref($e->{TYPE}) eq "HASH") {
+ $e->{TYPE} = ParseType($e->{TYPE}, $pointer_default);
+ }
+
return {
NAME => $e->{NAME},
TYPE => $e->{TYPE},
PROPERTIES => $e->{PROPERTIES},
LEVELS => GetElementLevelTable($e),
- REPRESENTATION_TYPE => $e->{PROPERTIES}->{represent_as},
+ REPRESENTATION_TYPE => ($e->{PROPERTIES}->{represent_as} or $e->{TYPE}),
ALIGN => align_type($e->{TYPE}),
ORIGINAL => $e
};
sub ParseStruct($$)
{
- my ($ndr,$struct) = @_;
+ my ($struct, $pointer_default) = @_;
my @elements = ();
my $surrounding = undef;
+ return {
+ TYPE => "STRUCT",
+ NAME => $struct->{NAME},
+ SURROUNDING_ELEMENT => undef,
+ ELEMENTS => undef,
+ PROPERTIES => $struct->{PROPERTIES},
+ ORIGINAL => $struct,
+ ALIGN => undef
+ } unless defined($struct->{ELEMENTS});
+
+ CheckPointerTypes($struct, $pointer_default);
+
foreach my $x (@{$struct->{ELEMENTS}})
{
- my $e = ParseElement($x);
+ my $e = ParseElement($x, $pointer_default);
if ($x != $struct->{ELEMENTS}[-1] and
$e->{LEVELS}[0]->{IS_SURROUNDING}) {
- print "$x->{FILE}:$x->{LINE}: error: conformant member not at end of struct\n";
+ fatal($x, "conformant member not at end of struct");
}
push @elements, $e;
}
&& property_matches($e, "flag", ".*LIBNDR_FLAG_STR_CONFORMANT.*")) {
$surrounding = $struct->{ELEMENTS}[-1];
}
+
+ my $align = undef;
+ if ($struct->{NAME}) {
+ $align = align_type($struct->{NAME});
+ }
return {
TYPE => "STRUCT",
+ NAME => $struct->{NAME},
SURROUNDING_ELEMENT => $surrounding,
ELEMENTS => \@elements,
PROPERTIES => $struct->{PROPERTIES},
- ORIGINAL => $struct
+ ORIGINAL => $struct,
+ ALIGN => $align
};
}
sub ParseUnion($$)
{
- my ($ndr,$e) = @_;
+ my ($e, $pointer_default) = @_;
my @elements = ();
+ my $hasdefault = 0;
my $switch_type = has_property($e, "switch_type");
unless (defined($switch_type)) { $switch_type = "uint32"; }
-
if (has_property($e, "nodiscriminant")) { $switch_type = undef; }
-
- my $hasdefault = 0;
+
+ return {
+ TYPE => "UNION",
+ NAME => $e->{NAME},
+ SWITCH_TYPE => $switch_type,
+ ELEMENTS => undef,
+ PROPERTIES => $e->{PROPERTIES},
+ HAS_DEFAULT => $hasdefault,
+ ORIGINAL => $e
+ } unless defined($e->{ELEMENTS});
+
+ CheckPointerTypes($e, $pointer_default);
+
foreach my $x (@{$e->{ELEMENTS}})
{
my $t;
if ($x->{TYPE} eq "EMPTY") {
$t = { TYPE => "EMPTY" };
} else {
- $t = ParseElement($x);
+ $t = ParseElement($x, $pointer_default);
}
if (has_property($x, "default")) {
$t->{CASE} = "default";
return {
TYPE => "UNION",
+ NAME => $e->{NAME},
SWITCH_TYPE => $switch_type,
ELEMENTS => \@elements,
PROPERTIES => $e->{PROPERTIES},
sub ParseEnum($$)
{
- my ($ndr,$e) = @_;
+ my ($e, $pointer_default) = @_;
return {
TYPE => "ENUM",
+ NAME => $e->{NAME},
BASE_TYPE => Parse::Pidl::Typelist::enum_type_fn($e),
ELEMENTS => $e->{ELEMENTS},
PROPERTIES => $e->{PROPERTIES},
sub ParseBitmap($$)
{
- my ($ndr,$e) = @_;
+ my ($e, $pointer_default) = @_;
return {
TYPE => "BITMAP",
+ NAME => $e->{NAME},
BASE_TYPE => Parse::Pidl::Typelist::bitmap_type_fn($e),
ELEMENTS => $e->{ELEMENTS},
PROPERTIES => $e->{PROPERTIES},
sub ParseType($$)
{
- my ($ndr, $d) = @_;
-
- if ($d->{TYPE} eq "STRUCT" or $d->{TYPE} eq "UNION") {
- CheckPointerTypes($d, $ndr->{PROPERTIES}->{pointer_default});
- }
+ my ($d, $pointer_default) = @_;
my $data = {
STRUCT => \&ParseStruct,
ENUM => \&ParseEnum,
BITMAP => \&ParseBitmap,
TYPEDEF => \&ParseTypedef,
- }->{$d->{TYPE}}->($ndr, $d);
+ }->{$d->{TYPE}}->($d, $pointer_default);
return $data;
}
sub ParseTypedef($$)
{
- my ($ndr,$d) = @_;
+ my ($d, $pointer_default) = @_;
- if (defined($d->{PROPERTIES}) && !defined($d->{DATA}->{PROPERTIES})) {
- $d->{DATA}->{PROPERTIES} = $d->{PROPERTIES};
+ if (defined($d->{DATA}->{PROPERTIES}) && !defined($d->{PROPERTIES})) {
+ $d->{PROPERTIES} = $d->{DATA}->{PROPERTIES};
}
- my $data = ParseType($ndr, $d->{DATA});
+ my $data = ParseType($d->{DATA}, $pointer_default);
$data->{ALIGN} = align_type($d->{NAME});
return {
}
foreach my $x (@{$d->{ELEMENTS}}) {
- my $e = ParseElement($x);
+ my $e = ParseElement($x, $ndr->{PROPERTIES}->{pointer_default});
push (@{$e->{DIRECTION}}, "in") if (has_property($x, "in"));
push (@{$e->{DIRECTION}}, "out") if (has_property($x, "out"));
{
my ($s,$default) = @_;
+ return unless defined($s->{ELEMENTS});
+
foreach my $e (@{$s->{ELEMENTS}}) {
if ($e->{POINTERS} and not defined(pointer_type($e))) {
$e->{PROPERTIES}->{$default} = 1;
}
}
+sub FindNestedTypes($$)
+{
+ sub FindNestedTypes($$);
+ my ($l, $t) = @_;
+
+ return if not defined($t->{ELEMENTS});
+ return if ($t->{TYPE} eq "ENUM");
+ return if ($t->{TYPE} eq "BITMAP");
+
+ foreach (@{$t->{ELEMENTS}}) {
+ if (ref($_->{TYPE}) eq "HASH") {
+ push (@$l, $_->{TYPE}) if (defined($_->{TYPE}->{NAME}));
+ FindNestedTypes($l, $_->{TYPE});
+ }
+ }
+}
+
sub ParseInterface($)
{
my $idl = shift;
my @consts = ();
my @functions = ();
my @endpoints;
- my @declares = ();
my $opnum = 0;
my $version;
}
foreach my $d (@{$idl->{DATA}}) {
- if ($d->{TYPE} eq "DECLARE") {
- push (@declares, $d);
- } elsif ($d->{TYPE} eq "FUNCTION") {
+ if ($d->{TYPE} eq "FUNCTION") {
push (@functions, ParseFunction($idl, $d, \$opnum));
} elsif ($d->{TYPE} eq "CONST") {
push (@consts, ParseConst($idl, $d));
} else {
- push (@types, ParseType($idl, $d));
+ push (@types, ParseType($d, $idl->{PROPERTIES}->{pointer_default}));
+ FindNestedTypes(\@types, $d);
}
}
FUNCTIONS => \@functions,
CONSTS => \@consts,
TYPES => \@types,
- DECLARES => \@declares,
ENDPOINTS => \@endpoints
};
}
my @ndr = ();
foreach (@{$idl}) {
+ ($_->{TYPE} eq "CPP_QUOTE") && push(@ndr, $_);
($_->{TYPE} eq "INTERFACE") && push(@ndr, ParseInterface($_));
($_->{TYPE} eq "IMPORT") && push(@ndr, $_);
}
sub mapToScalar($)
{
+ sub mapToScalar($);
my $t = shift;
+ return $t->{NAME} if (ref($t) eq "HASH" and $t->{TYPE} eq "SCALAR");
my $ti = getType($t);
if (not defined ($ti)) {
return undef;
- } elsif ($ti->{DATA}->{TYPE} eq "ENUM") {
- return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
- } elsif ($ti->{DATA}->{TYPE} eq "BITMAP") {
- return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
- } elsif ($ti->{DATA}->{TYPE} eq "SCALAR") {
- return $t;
+ } elsif ($ti->{TYPE} eq "TYPEDEF") {
+ return mapToScalar($ti->{DATA});
+ } elsif ($ti->{TYPE} eq "ENUM") {
+ return Parse::Pidl::Typelist::enum_type_fn($ti);
+ } elsif ($ti->{TYPE} eq "BITMAP") {
+ return Parse::Pidl::Typelist::bitmap_type_fn($ti);
}
return undef;
}
#####################################################################
-# parse a struct
+# validate an element
sub ValidElement($)
{
my $e = shift;
fatal($e, el_name($e) . ": switch_is() used on non-union type $e->{TYPE} which is a $type->{DATA}->{TYPE}");
}
- if (!has_property($type, "nodiscriminant") and defined($e2)) {
- my $discriminator_type = has_property($type, "switch_type");
+ if (not has_property($type->{DATA}, "nodiscriminant") and defined($e2)) {
+ my $discriminator_type = has_property($type->{DATA}, "switch_type");
$discriminator_type = "uint32" unless defined ($discriminator_type);
my $t1 = mapToScalar($discriminator_type);
}
#####################################################################
-# parse a struct
+# validate an enum
+sub ValidEnum($)
+{
+ my ($enum) = @_;
+
+ ValidProperties($enum, "ENUM");
+}
+
+#####################################################################
+# validate a bitmap
+sub ValidBitmap($)
+{
+ my ($bitmap) = @_;
+
+ ValidProperties($bitmap, "BITMAP");
+}
+
+#####################################################################
+# validate a struct
sub ValidStruct($)
{
my($struct) = shift;
- ValidProperties($struct,"STRUCT");
+ ValidProperties($struct, "STRUCT");
+
+ return unless defined($struct->{ELEMENTS});
foreach my $e (@{$struct->{ELEMENTS}}) {
$e->{PARENT} = $struct;
if (has_property($union->{PARENT}, "nodiscriminant") and has_property($union->{PARENT}, "switch_type")) {
fatal($union->{PARENT}, $union->{PARENT}->{NAME} . ": switch_type() on union without discriminant");
}
-
+
+ return unless defined($union->{ELEMENTS});
+
foreach my $e (@{$union->{ELEMENTS}}) {
$e->{PARENT} = $union;
my($typedef) = shift;
my $data = $typedef->{DATA};
- ValidProperties($typedef,"TYPEDEF");
+ ValidProperties($typedef, "TYPEDEF");
$data->{PARENT} = $typedef;
- if (ref($data) eq "HASH") {
- if ($data->{TYPE} eq "STRUCT") {
- ValidStruct($data);
- }
-
- if ($data->{TYPE} eq "UNION") {
- ValidUnion($data);
- }
- }
+ ValidType($data) if (ref($data) eq "HASH");
}
#####################################################################
-# parse a function
+# validate a function
sub ValidFunction($)
{
my($fn) = shift;
}
}
+#####################################################################
+# validate a type
+sub ValidType($)
+{
+ my ($t) = @_;
+
+ {
+ TYPEDEF => \&ValidTypedef,
+ STRUCT => \&ValidStruct,
+ UNION => \&ValidUnion,
+ ENUM => \&ValidEnum,
+ BITMAP => \&ValidBitmap
+ }->{$t->{TYPE}}->($t);
+}
+
#####################################################################
# parse the interface definitions
sub ValidInterface($)
}
foreach my $d (@{$data}) {
- ($d->{TYPE} eq "TYPEDEF") &&
- ValidTypedef($d);
- ($d->{TYPE} eq "FUNCTION") &&
- ValidFunction($d);
+ ($d->{TYPE} eq "FUNCTION") && ValidFunction($d);
+ ($d->{TYPE} eq "TYPEDEF" or
+ $d->{TYPE} eq "STRUCT" or
+ $d->{TYPE} eq "UNION" or
+ $d->{TYPE} eq "ENUM" or
+ $d->{TYPE} eq "BITMAP") && ValidType($d);
}
}
($x->{TYPE} eq "INTERFACE") &&
ValidInterface($x);
($x->{TYPE} eq "IMPORTLIB") &&
- warning($x, "importlib() not supported");
+ fatal($x, "importlib() not supported");
}
}
git.samba.org / ira / wip.git / blobdiff