r12490: Fix --warn-compat

(This used to be commit ba6a767f1b3a14e076ebd049b4fdcffd64173523)

diff --git a/source4/pidl/TODO b/source4/pidl/TODO
index f48af8c38caed8e5b69ae6cfe629a75276e6f540..a99a4f3f5f021e3df92d5f21de16bfc542c6d641 100644 (file)
--- 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 2e7d686249567e1f2636e0f8567fbf3b5f3ab186..f0b8cc7b0b167977c379d8aa5ae08a02cffe0f1f 100644 (file)
--- 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 b9044078eae0d9cbe9a72ffddfe03f09e5fbf504..83df9afe885adcd345ec7af3ad813b77d16c3fc5 100644 (file)
--- 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";