diff options
| -rw-r--r-- | source4/pidl/TODO | 1 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Compat.pm | 52 | ||||
| -rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm | 17 |
3 files changed, 23 insertions, 47 deletions
diff --git a/source4/pidl/TODO b/source4/pidl/TODO index f48af8c38c..a99a4f3f5f 100644 --- a/source4/pidl/TODO +++ b/source4/pidl/TODO @@ -7,6 +7,7 @@ a (regular) remote error occurs - support nested elements + - generate names for anonymous tagged types - auto-alloc [ref] pointers for Samba4 during pull if they were NULL diff --git a/source4/pidl/lib/Parse/Pidl/Compat.pm b/source4/pidl/lib/Parse/Pidl/Compat.pm index 2e7d686249..f0b8cc7b0b 100644 --- a/source4/pidl/lib/Parse/Pidl/Compat.pm +++ b/source4/pidl/lib/Parse/Pidl/Compat.pm @@ -74,29 +74,19 @@ my %supported_properties = ( "length_is" => ["ELEMENT"], ); - -my($res); - sub warning($$) { - my $l = shift; - my $m = shift; - - print "$l->{FILE}:$l->{LINE}:Warning:$m\n"; -} - -sub error($$) -{ my ($l,$m) = @_; - print "$l->{FILE}:$l->{LINE}:$m\n"; + + print STDERR "$l->{FILE}:$l->{LINE}:warning:$m\n"; } sub CheckTypedef($) { - my $td = shift; + my ($td) = @_; if (has_property($td, "nodiscriminant")) { - error($td, "nodiscriminant property not supported"); + warning($td, "nodiscriminant property not supported"); } if ($td->{TYPE} eq "BITMAP") { @@ -121,7 +111,7 @@ sub CheckElement($) my $e = shift; if (has_property($e, "noheader")) { - error($e, "noheader property not supported"); + warning($e, "noheader property not supported"); return; } @@ -131,30 +121,28 @@ sub CheckElement($) } if (has_property($e, "compression")) { - error($e, "compression() property not supported"); + warning($e, "compression() property not supported"); } if (has_property($e, "obfuscation")) { - error($e, "obfuscation() property not supported"); + warning($e, "obfuscation() property not supported"); } if (has_property($e, "sptr")) { - error($e, "sptr() pointer property not supported"); + warning($e, "sptr() pointer property not supported"); } if (has_property($e, "relative")) { - error($e, "relative() pointer property not supported"); + warning($e, "relative() pointer property not supported"); } - if (has_property($td, "flag")) { + if (has_property($e, "flag")) { warning($e, "ignoring flag() property"); } - if (has_property($td, "value")) { + if (has_property($e, "value")) { warning($e, "ignoring value() property"); } - - StripProperties($e); } sub CheckFunction($) @@ -162,12 +150,8 @@ sub CheckFunction($) my $fn = shift; if (has_property($fn, "noopnum")) { - error($fn, "noopnum not converted. Opcodes will be out of sync."); + warning($fn, "noopnum not converted. Opcodes will be out of sync."); } - - StripProperties($fn); - - } sub CheckInterface($) @@ -176,11 +160,9 @@ sub CheckInterface($) if (has_property($if, "pointer_default_top") and $if->{PROPERTIES}->{pointer_default_top} ne "ref") { - error($if, "pointer_default_top() is pidl-specific"); + warning($if, "pointer_default_top() is pidl-specific"); } - StripProperties($if); - foreach my $x (@{$if->{DATA}}) { if ($x->{TYPE} eq "DECLARE") { warning($if, "the declare keyword is pidl-specific"); @@ -193,14 +175,10 @@ sub Check($) { my $pidl = shift; my $nidl = []; - my $res = ""; - foreach my $x (@{$pidl}) { - push (@$nidl, CheckInterface($x)) - if ($x->{TYPE} eq "INTERFACE"); + foreach (@{$pidl}) { + push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE"); } - - return $res; } 1; diff --git a/source4/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm b/source4/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm index b9044078ea..83df9afe88 100644 --- a/source4/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm +++ b/source4/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm @@ -3,8 +3,8 @@ package Parse::Pidl::Samba4::COM::Header; -use Parse::Pidl::Typelist; -use Parse::Pidl::Util qw(has_property); +use Parse::Pidl::Typelist qw(mapType); +use Parse::Pidl::Util qw(has_property is_constant); use vars qw($VERSION); $VERSION = '0.01'; @@ -18,7 +18,7 @@ sub GetArgumentProtoList($) foreach my $a (@{$f->{ELEMENTS}}) { - $res .= ", " . Parse::Pidl::Typelist::mapType($a->{TYPE}) . " "; + $res .= ", " . mapType($a->{TYPE}) . " "; my $l = $a->{POINTERS}; $l-- if (Parse::Pidl::Typelist::scalar_is_reference($a->{TYPE})); @@ -26,13 +26,12 @@ sub GetArgumentProtoList($) $res .= "*"; } - if (defined $a->{ARRAY_LEN}[0] && - !Parse::Pidl::Util::is_constant($a->{ARRAY_LEN}[0]) && + if (defined $a->{ARRAY_LEN}[0] && !is_constant($a->{ARRAY_LEN}[0]) && !$a->{POINTERS}) { $res .= "*"; } $res .= $a->{NAME}; - if (defined $a->{ARRAY_LEN}[0] && Parse::Pidl::Util::is_constant($a->{ARRAY_LEN}[0])) { + if (defined $a->{ARRAY_LEN}[0] && is_constant($a->{ARRAY_LEN}[0])) { $res .= "[$a->{ARRAY_LEN}[0]]"; } } @@ -45,9 +44,7 @@ sub GetArgumentList($) my $f = shift; my $res = ""; - foreach my $a (@{$f->{ELEMENTS}}) { - $res .= ", $a->{NAME}"; - } + foreach (@{$f->{ELEMENTS}}) { $res .= ", $_->{NAME}"; } return $res; } @@ -65,7 +62,7 @@ sub HeaderVTable($) my $data = $interface->{DATA}; foreach my $d (@{$data}) { - $res .= "\t" . Parse::Pidl::Typelist::mapType($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION"); + $res .= "\t" . mapType($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION"); } $res .= "\n"; $res .= "struct $interface->{NAME}_vtable {\n"; |