# Samba4 NDR info tree generator
# Copyright tridge@samba.org 2000-2003
# Copyright tpot@samba.org 2001
-# Copyright jelmer@samba.org 2004-2005
+# Copyright jelmer@samba.org 2004-2006
# released under the GNU GPL
=pod
=head1 DESCRIPTION
-#####################################################################
-# return a table describing the order in which the parts of an element
-# should be parsed
-# Possible level types:
-# - POINTER
-# - ARRAY
-# - SUBCONTEXT
-# - SWITCH
-# - DATA
+Return a table describing the order in which the parts of an element
+should be parsed
+Possible level types:
+ - POINTER
+ - ARRAY
+ - SUBCONTEXT
+ - SWITCH
+ - DATA
+
+=head1 AUTHOR
+
+Jelmer Vernooij <jelmer@samba.org>
=cut
$VERSION = '0.01';
@ISA = qw(Exporter);
@EXPORT = qw(GetPrevLevel GetNextLevel ContainsDeferred ContainsString);
+@EXPORT_OK = qw(GetElementLevelTable ParseElement ValidElement align_type mapToScalar ParseType can_contain_deferred);
use strict;
-use Parse::Pidl::Typelist qw(hasType getType);
+use Parse::Pidl qw(warning fatal);
+use Parse::Pidl::Typelist qw(hasType getType expandAlias);
use Parse::Pidl::Util qw(has_property property_matches);
# Alignment of the built-in scalar types
'int32' => 4,
'uint32' => 4,
'hyper' => 8,
+ 'pointer' => 8,
'dlong' => 4,
'udlong' => 4,
'udlongr' => 4,
'ipv4address' => 4
};
-
-
-sub nonfatal($$)
-{
- my ($e,$s) = @_;
- warn ("$e->{FILE}:$e->{LINE}: Warning: $s\n");
-}
-
-#####################################################################
-# signal a fatal validation error
-sub fatal($$)
-{
- my ($pos,$s) = @_;
- die("$pos->{FILE}:$pos->{LINE}:$s\n");
-}
-
sub GetElementLevelTable($)
{
my $e = shift;
if (defined($e->{ARRAY_LEN})) {
@bracket_array = @{$e->{ARRAY_LEN}};
}
-
+
+ if (has_property($e, "out")) {
+ my $needptrs = 1;
+
+ if (has_property($e, "string")) { $needptrs++; }
+ if ($#bracket_array >= 0) { $needptrs = 0; }
+
+ warning($e, "[out] argument `$e->{NAME}' not a pointer") if ($needptrs > $e->{POINTERS});
+ }
+
# Parse the [][][][] style array stuff
- foreach my $d (@bracket_array) {
+ for my $i (0 .. $#bracket_array) {
+ my $d = $bracket_array[$#bracket_array - $i];
my $size = $d;
my $length = $d;
my $is_surrounding = 0;
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_string = 1;
delete($e->{PROPERTIES}->{string});
} else {
- print "$e->{FILE}:$e->{LINE}: Must specify size_is() for conformant array!\n";
- exit 1;
+ fatal($e, "Must specify size_is() for conformant array!")
}
if (($length = shift @length_is) or $is_string) {
}
}
+ $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
});
}
LEVEL => $level
});
+ warning($e, "top-level \[out\] pointer `$e->{NAME}' is not a \[ref\] pointer")
+ if ($i == 1 and pointer_type($e) ne "ref" and
+ $e->{PARENT}->{TYPE} eq "FUNCTION" and
+ not has_property($e, "in"));
+
$pointer_idx++;
# everything that follows will be deferred
}
}
- if (scalar(@size_is) == 0 and has_property($e, "string")) {
+ if (scalar(@size_is) == 0 and has_property($e, "string") and
+ $i == $e->{POINTERS}) {
$is_string = 1;
$is_varying = $is_conformant = has_property($e, "noheader")?0:1;
delete($e->{PROPERTIES}->{string});
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;
SUBCONTEXT_SIZE => $subsize,
IS_DEFERRED => $is_deferred,
COMPRESSION => has_property($e, "compression"),
- OBFUSCATION => has_property($e, "obfuscation")
});
}
}
if (scalar(@size_is) > 0) {
- nonfatal($e, "size_is() on non-array element");
+ fatal($e, "size_is() on non-array element");
}
if (scalar(@length_is) > 0) {
- nonfatal($e, "length_is() on non-array element");
+ fatal($e, "length_is() on non-array element");
}
if (has_property($e, "string")) {
- nonfatal($e, "string() attribute on non-array element");
+ fatal($e, "string() attribute on non-array element");
}
push (@$order, {
TYPE => "DATA",
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 0 if (Parse::Pidl::Typelist::is_scalar($e->{TYPE}));
- return 1 unless (hasType($e->{TYPE})); # assume the worst
+ return 1 unless (hasType($type)); # assume the worst
- my $type = getType($e->{TYPE});
+ $type = getType($type);
- foreach my $x (@{$type->{DATA}->{ELEMENTS}}) {
- return 1 if ($x->{POINTERS});
- return 1 if (can_contain_deferred ($x));
+ return 0 if (Parse::Pidl::Typelist::is_scalar($type));
+
+ 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;
return undef unless $e->{POINTERS};
return "ref" if (has_property($e, "ref"));
- return "ptr" if (has_property($e, "ptr"));
+ return "full" if (has_property($e, "ptr"));
return "sptr" if (has_property($e, "sptr"));
return "unique" if (has_property($e, "unique"));
return "relative" if (has_property($e, "relative"));
if ($e->{POINTERS}) {
$a = 4;
- } elsif (has_property($e, "subcontext")){
+ } elsif (has_property($e, "subcontext")) {
$a = 1;
+ } elsif (has_property($e, "transmit_as")) {
+ $a = align_type($e->{PROPERTIES}->{transmit_as});
} else {
$a = align_type($e->{TYPE});
}
#####################################################################
# align a type
-sub align_type
+sub align_type($)
{
- my $e = shift;
+ sub align_type($);
+ 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} or $e->{TYPE}),
ALIGN => align_type($e->{TYPE}),
ORIGINAL => $e
};
}
-sub ParseStruct($)
+sub ParseStruct($$)
{
- my $struct = shift;
+ 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($)
+sub ParseUnion($$)
{
- my $e = shift;
+ 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($)
+sub ParseEnum($$)
{
- my $e = shift;
+ 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($)
+sub ParseBitmap($$)
{
- my $e = shift;
+ 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 ParseTypedef($$)
+sub ParseType($$)
{
- my ($ndr,$d) = @_;
- my $data;
-
- if ($d->{DATA}->{TYPE} eq "STRUCT" or $d->{DATA}->{TYPE} eq "UNION") {
- CheckPointerTypes($d->{DATA}, $ndr->{PROPERTIES}->{pointer_default});
- }
-
- if (defined($d->{PROPERTIES}) && !defined($d->{DATA}->{PROPERTIES})) {
- $d->{DATA}->{PROPERTIES} = $d->{PROPERTIES};
- }
+ my ($d, $pointer_default) = @_;
- $data = {
+ my $data = {
STRUCT => \&ParseStruct,
UNION => \&ParseUnion,
ENUM => \&ParseEnum,
- BITMAP => \&ParseBitmap
- }->{$d->{DATA}->{TYPE}}->($d->{DATA});
+ BITMAP => \&ParseBitmap,
+ TYPEDEF => \&ParseTypedef,
+ }->{$d->{TYPE}}->($d, $pointer_default);
+
+ return $data;
+}
+sub ParseTypedef($$)
+{
+ my ($d, $pointer_default) = @_;
+
+ if (defined($d->{DATA}->{PROPERTIES}) && !defined($d->{PROPERTIES})) {
+ $d->{PROPERTIES} = $d->{DATA}->{PROPERTIES};
+ }
+
+ 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"));
+
push (@elements, $e);
}
if ($d->{RETURN_TYPE} ne "void") {
- $rettype = $d->{RETURN_TYPE};
+ $rettype = expandAlias($d->{RETURN_TYPE});
}
+ my $async = 0;
+ if (has_property($d, "async")) { $async = 1; }
+
return {
NAME => $d->{NAME},
TYPE => "FUNCTION",
OPNUM => $thisopnum,
+ ASYNC => $async,
RETURN_TYPE => $rettype,
PROPERTIES => $d->{PROPERTIES},
ELEMENTS => \@elements,
sub CheckPointerTypes($$)
{
- my $s = shift;
- my $default = shift;
+ my ($s,$default) = @_;
+
+ return unless defined($s->{ELEMENTS});
foreach my $e (@{$s->{ELEMENTS}}) {
if ($e->{POINTERS} and not defined(pointer_type($e))) {
}
}
+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 @typedefs = ();
+ my @types = ();
my @consts = ();
my @functions = ();
my @endpoints;
- my @declares = ();
my $opnum = 0;
my $version;
if (not has_property($idl, "pointer_default_top")) {
$idl->{PROPERTIES}->{pointer_default_top} = "ref";
+ } else {
+ warning($idl, "pointer_default_top() is a pidl extension and should not be used");
}
foreach my $d (@{$idl->{DATA}}) {
- if ($d->{TYPE} eq "TYPEDEF") {
- push (@typedefs, ParseTypedef($idl, $d));
- }
-
- if ($d->{TYPE} eq "DECLARE") {
- push (@declares, $d);
- }
-
if ($d->{TYPE} eq "FUNCTION") {
push (@functions, ParseFunction($idl, $d, \$opnum));
- }
-
- if ($d->{TYPE} eq "CONST") {
+ } elsif ($d->{TYPE} eq "CONST") {
push (@consts, ParseConst($idl, $d));
+ } else {
+ push (@types, ParseType($d, $idl->{PROPERTIES}->{pointer_default}));
+ FindNestedTypes(\@types, $d);
}
}
return {
NAME => $idl->{NAME},
- UUID => has_property($idl, "uuid"),
+ UUID => lc(has_property($idl, "uuid")),
VERSION => $version,
TYPE => "INTERFACE",
PROPERTIES => $idl->{PROPERTIES},
FUNCTIONS => \@functions,
CONSTS => \@consts,
- TYPEDEFS => \@typedefs,
- DECLARES => \@declares,
+ TYPES => \@types,
ENDPOINTS => \@endpoints
};
}
sub Parse($)
{
my $idl = shift;
+
+ return undef unless (defined($idl));
+
+ Parse::Pidl::NDR::Validate($idl);
+
my @ndr = ();
- push(@ndr, ParseInterface($_)) foreach (@{$idl});
+ foreach (@{$idl}) {
+ ($_->{TYPE} eq "CPP_QUOTE") && push(@ndr, $_);
+ ($_->{TYPE} eq "INTERFACE") && push(@ndr, ParseInterface($_));
+ ($_->{TYPE} eq "IMPORT") && push(@ndr, $_);
+ }
return \@ndr;
}
"endpoint" => ["INTERFACE"],
"pointer_default" => ["INTERFACE"],
"pointer_default_top" => ["INTERFACE"],
- "depends" => ["INTERFACE"],
+ "helper" => ["INTERFACE"],
"authservice" => ["INTERFACE"],
# dcom
"noopnum" => ["FUNCTION"],
"in" => ["ELEMENT"],
"out" => ["ELEMENT"],
+ "async" => ["FUNCTION"],
# pointer
"ref" => ["ELEMENT"],
"ptr" => ["ELEMENT"],
- "sptr" => ["ELEMENT"],
"unique" => ["ELEMENT"],
"ignore" => ["ELEMENT"],
"relative" => ["ELEMENT"],
"public" => ["FUNCTION", "TYPEDEF"],
"nopush" => ["FUNCTION", "TYPEDEF"],
"nopull" => ["FUNCTION", "TYPEDEF"],
+ "nosize" => ["FUNCTION", "TYPEDEF"],
"noprint" => ["FUNCTION", "TYPEDEF"],
"noejs" => ["FUNCTION", "TYPEDEF"],
"case" => ["ELEMENT"],
"default" => ["ELEMENT"],
+ "represent_as" => ["ELEMENT"],
+ "transmit_as" => ["ELEMENT"],
+
# subcontext
"subcontext" => ["ELEMENT"],
"subcontext_size" => ["ELEMENT"],
"compression" => ["ELEMENT"],
- "obfuscation" => ["ELEMENT"],
# enum
"enum8bit" => ["TYPEDEF"],
return unless defined $e->{PROPERTIES};
foreach my $key (keys %{$e->{PROPERTIES}}) {
- fatal($e, el_name($e) . ": unknown property '$key'\n")
+ warning($e, el_name($e) . ": unknown property '$key'")
unless defined($property_list{$key});
- fatal($e, el_name($e) . ": property '$key' not allowed on '$t'\n")
+ fatal($e, el_name($e) . ": property '$key' not allowed on '$t'")
unless grep($t, @{$property_list{$key}});
}
}
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;
ValidProperties($e,"ELEMENT");
- if (has_property($e, "ptr")) {
- fatal($e, el_name($e) . " : pidl does not support full NDR pointers yet\n");
- }
-
# Check whether switches are used correctly.
if (my $switch = has_property($e, "switch_is")) {
my $e2 = find_sibling($e, $switch);
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);
}
if ($t1 ne $t2) {
- nonfatal($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
+ warning($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
}
}
}
+ if (has_property($e, "subcontext") and has_property($e, "represent_as")) {
+ fatal($e, el_name($e) . " : subcontext() and represent_as() can not be used on the same element");
+ }
+
+ if (has_property($e, "subcontext") and has_property($e, "transmit_as")) {
+ fatal($e, el_name($e) . " : subcontext() and transmit_as() can not be used on the same element");
+ }
+
+ if (has_property($e, "represent_as") and has_property($e, "transmit_as")) {
+ fatal($e, el_name($e) . " : represent_as() and transmit_as() can not be used on the same element");
+ }
+
+ if (has_property($e, "represent_as") and has_property($e, "value")) {
+ fatal($e, el_name($e) . " : represent_as() and value() can not be used on the same element");
+ }
+
+ if (has_property($e, "subcontext")) {
+ warning($e, "subcontext() is deprecated. Use represent_as() or transmit_as() instead");
+ }
+
if (defined (has_property($e, "subcontext_size")) and not defined(has_property($e, "subcontext"))) {
fatal($e, el_name($e) . " : subcontext_size() on non-subcontext element");
}
fatal($e, el_name($e) . " : compression() on non-subcontext element");
}
- if (defined (has_property($e, "obfuscation")) and not defined(has_property($e, "subcontext"))) {
- fatal($e, el_name($e) . " : obfuscation() on non-subcontext element");
- }
-
if (!$e->{POINTERS} && (
has_property($e, "ptr") or
- has_property($e, "sptr") or
has_property($e, "unique") or
has_property($e, "relative") or
has_property($e, "ref"))) {
}
#####################################################################
-# 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;
if (defined($e->{PROPERTIES}->{default}) and
defined($e->{PROPERTIES}->{case})) {
- fatal $e, "Union member $e->{NAME} can not have both default and case properties!\n";
+ fatal($e, "Union member $e->{NAME} can not have both default and case properties!");
}
unless (defined ($e->{PROPERTIES}->{default}) or
defined ($e->{PROPERTIES}->{case})) {
- fatal $e, "Union member $e->{NAME} must have default or case property\n";
+ fatal($e, "Union member $e->{NAME} must have default or case property");
}
if (has_property($e, "ref")) {
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;
foreach my $e (@{$fn->{ELEMENTS}}) {
$e->{PARENT} = $fn;
if (has_property($e, "ref") && !$e->{POINTERS}) {
- fatal $e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
+ fatal($e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})");
}
ValidElement($e);
}
}
+#####################################################################
+# 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($)
my($interface) = shift;
my($data) = $interface->{DATA};
+ if (has_property($interface, "helper")) {
+ warning($interface, "helper() is pidl-specific and deprecated. Use `include' instead");
+ }
+
ValidProperties($interface,"INTERFACE");
- if (has_property($interface, "pointer_default") &&
- $interface->{PROPERTIES}->{pointer_default} eq "ptr") {
- fatal $interface, "Full pointers are not supported yet\n";
+ if (has_property($interface, "pointer_default")) {
+ if (not grep (/$interface->{PROPERTIES}->{pointer_default}/,
+ ("ref", "unique", "ptr"))) {
+ fatal($interface, "Unknown default pointer type `$interface->{PROPERTIES}->{pointer_default}'");
+ }
}
if (has_property($interface, "object")) {
if (has_property($interface, "version") &&
$interface->{PROPERTIES}->{version} != 0) {
- fatal $interface, "Object interfaces must have version 0.0 ($interface->{NAME})\n";
+ fatal($interface, "Object interfaces must have version 0.0 ($interface->{NAME})");
}
if (!defined($interface->{BASE}) &&
not ($interface->{NAME} eq "IUnknown")) {
- fatal $interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
+ fatal($interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})");
}
}
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);
}
}
foreach my $x (@{$idl}) {
($x->{TYPE} eq "INTERFACE") &&
ValidInterface($x);
+ ($x->{TYPE} eq "IMPORTLIB") &&
+ fatal($x, "importlib() not supported");
}
}
git.samba.org / ira / wip.git / blobdiff