svn commit: samba r12490 - in branches/SAMBA_4_0/source/pidl: . lib/Parse/Pidl lib/Parse/Pidl/Samba4/COM

jelmer at samba.org jelmer at samba.org
Mon Dec 26 02:14:18 GMT 2005


Author: jelmer
Date: 2005-12-26 02:14:18 +0000 (Mon, 26 Dec 2005)
New Revision: 12490

WebSVN: http://websvn.samba.org/cgi-bin/viewcvs.cgi?view=rev&root=samba&rev=12490

Log:
Fix --warn-compat

Modified:
   branches/SAMBA_4_0/source/pidl/TODO
   branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Compat.pm
   branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm


Changeset:
Modified: branches/SAMBA_4_0/source/pidl/TODO
===================================================================
--- branches/SAMBA_4_0/source/pidl/TODO	2005-12-26 02:04:09 UTC (rev 12489)
+++ branches/SAMBA_4_0/source/pidl/TODO	2005-12-26 02:14:18 UTC (rev 12490)
@@ -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
  

Modified: branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Compat.pm
===================================================================
--- branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Compat.pm	2005-12-26 02:04:09 UTC (rev 12489)
+++ branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Compat.pm	2005-12-26 02:14:18 UTC (rev 12490)
@@ -74,29 +74,19 @@
 	"length_is"		=> ["ELEMENT"],
 );
 
-
-my($res);
-
 sub warning($$)
 {
-	my $l = shift;
-	my $m = shift;
+	my ($l,$m) = @_;
 
-	print "$l->{FILE}:$l->{LINE}:Warning:$m\n";
+	print STDERR "$l->{FILE}:$l->{LINE}:warning:$m\n";
 }
 
-sub error($$)
-{
-	my ($l,$m) = @_;
-	print "$l->{FILE}:$l->{LINE}:$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 @@
 	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 @@
 	}
 
 	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 @@
 	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 @@
 
 	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 @@
 {
 	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;

Modified: branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm
===================================================================
--- branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm	2005-12-26 02:04:09 UTC (rev 12489)
+++ branches/SAMBA_4_0/source/pidl/lib/Parse/Pidl/Samba4/COM/Header.pm	2005-12-26 02:14:18 UTC (rev 12490)
@@ -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 @@
 
 	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 @@
 			$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 @@
 	my $f = shift;
 	my $res = "";
 
-	foreach my $a (@{$f->{ELEMENTS}}) {
-		$res .= ", $a->{NAME}";
-	}
+	foreach (@{$f->{ELEMENTS}}) { $res .= ", $_->{NAME}"; }
 
 	return $res;
 }
@@ -65,7 +62,7 @@
 
 	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";



More information about the samba-cvs mailing list