r10718: Another large set of small improvements. All generated files compile

without warnings now. The only things left to do that are
required for DFS:
 - add allocation of arrays in marshalling phase
 - handling primitive and deferred data in embedded structures / unions.

Example output is again available from http://samba.org/~jelmer/pidl_samba3/
(This used to be commit 9fe724f6fb026d95306587f696c065f348aaf219)

4 files changed, 160 insertions, 56 deletions

diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
index d79aede138..b48a1b519f 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
@@ -58,6 +58,14 @@ sub ParseFunction($$)
 	pidl "\t$if->{NAME}_io_r_$fn->{NAME},";
 	pidl "\tNT_STATUS_UNSUCCESSFUL);";
 	pidl "";
+	pidl "/* Return variables */";
+	foreach (@{$fn->{ELEMENTS}}) {
+		next unless (grep(/out/, @{$_->{DIRECTION}}));
+
+		pidl "*$_->{NAME} = r.$_->{NAME};";
+	}
+
+	pidl"";
 	pidl "/* Return result */";
 	if (not $fn->{RETURN_TYPE}) {
 		pidl "return NT_STATUS_OK;";
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
index 1e0e2c7270..21a56e4c2d 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
@@ -31,6 +31,13 @@ sub ParseElement($)
 			pidl "\tuint32 level_$e->{NAME};";
 		} elsif ($l->{TYPE} eq "DATA") {
 			pidl "\t" . DeclShort($e) . ";";
+		} elsif ($l->{TYPE} eq "ARRAY") {
+			if ($l->{IS_CONFORMANT}) {
+				pidl "\tuint32 size_$e->{NAME};";
+			}
+			if ($l->{IS_VARYING}) {
+				pidl "\tuint32 length_$e->{NAME};";
+			}
 		}
 	}
 }
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
index 9a7c7d2578..166d98bfb1 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
@@ -23,26 +23,38 @@ sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
 
 #TODO:
 # - Different scalars / buffers functions for arrays + unions
-# - Memory allocation for arrays?
+# - Memory allocation for arrays
 
 sub DeclareArrayVariables($)
 {
 	my $es = shift;
 
+	my $output = 0;
+
 	foreach my $e (@$es) {
 		foreach my $l (@{$e->{LEVELS}}) {
 			if ($l->{TYPE} eq "ARRAY") {
 				pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};";
+				$output = 1;
 			}
 		}
 	}
+	pidl "" if $output;
 }
 
 sub ParseElementLevelData($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
-	pidl "if (!".DissectType($e, $l, $varname).")";
+	my @args = ($e,$l,$varname);
+
+	# See if we need to add a level argument because we're parsing a union
+	foreach (@{$e->{LEVELS}}) {
+		push (@args, ParseExpr("level_$e->{NAME}", $env)) 
+			if ($_->{TYPE} eq "SWITCH");
+	}
+
+	pidl "if (!".DissectType(@args).")";
 	pidl "\treturn False;";
 }
 
@@ -50,8 +62,10 @@ sub ParseElementLevelArray($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
+	my $len = ParseExpr($l->{LENGTH_IS}, $env);
+
 	my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}";
-	pidl "for ($i=0; $i<".ParseExpr("length_$e->{NAME}", $env) .";$i++) {";
+	pidl "for ($i=0; $i<$len;$i++) {";
 	indent;
 	ParseElementLevel($e,$nl,$env,$varname."[$i]");
 	deindent;
@@ -62,7 +76,7 @@ sub ParseElementLevelSwitch($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
-	pidl "if (!prs_uint32(\"level\", ps, depth, " . ParseExpr("level_$e->{NAME}", $env) . ", ps, depth))";
+	pidl "if (!prs_uint32(\"level\", ps, depth, &" . ParseExpr("level_$e->{NAME}", $env) . "))";
 	pidl "\treturn False;";
 	pidl "";
 
@@ -77,7 +91,7 @@ sub ParseElementLevelPtr($$$$$)
 		fatal($e, "relative pointers not supported for Samba 3");
 	}
 
-	pidl "if (!prs_uint32(\"ptr_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr_$e->{NAME}", $env) . ", ps, depth))";
+	pidl "if (!prs_uint32(\"ptr_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr_$e->{NAME}", $env) . "))";
 	pidl "\treturn False;";
 	pidl "";
 	
@@ -115,27 +129,22 @@ sub ParseElement($$)
 	ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env));
 }
 
-sub InitLevel($$$$);
-
 sub InitLevel($$$$)
 {
+	sub InitLevel($$$$);
 	my ($e,$l,$varname,$env) = @_;
 
 	if ($l->{TYPE} eq "POINTER") {
 		pidl "if ($varname) {";
 		indent;
 		pidl ParseExpr("ptr_$e->{NAME}", $env) . " = 1;";
-		InitLevel($e, GetNextLevel($e,$l), $varname, $env);
+		InitLevel($e, GetNextLevel($e,$l), "*$varname", $env);
 		deindent;
 		pidl "} else {";
 		pidl "\t" . ParseExpr("ptr_$e->{NAME}", $env) . " = 0;";
 		pidl "}";
 	} elsif ($l->{TYPE} eq "ARRAY") {
-		pidl "for (i = 0; i < " . ParseExpr("len_$e->{NAME}", $env) . "; i++) {";
-		indent;
-		InitLevel($e, GetNextLevel($e,$l), $varname."[i]", $env);
-		deindent;
-		pidl "}";
+		pidl ParseExpr($e->{NAME}, $env) . " = $varname;";
 	} elsif ($l->{TYPE} eq "DATA") {
 		pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
 	} elsif ($l->{TYPE} eq "SWITCH") {
@@ -143,6 +152,22 @@ sub InitLevel($$$$)
 	}
 }
 
+sub GenerateEnvElement($$)
+{
+	my ($e,$env) = @_;
+	foreach my $l (@{$e->{LEVELS}}) {
+		if ($l->{TYPE} eq "DATA") {
+			$env->{$e->{NAME}} = "v->$e->{NAME}";
+		} elsif ($l->{TYPE} eq "POINTER") {
+			$env->{"ptr_$e->{NAME}"} = "v->ptr_$e->{NAME}";
+		} elsif ($l->{TYPE} eq "SWITCH") {
+			$env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
+		} elsif ($l->{TYPE} eq "ARRAY") {
+			$env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
+		}
+	}
+}
+
 sub CreateStruct($$$$$)
 {
 	my ($fn,$ifn, $s,$es,$a) = @_;
@@ -153,19 +178,7 @@ sub CreateStruct($$$$$)
 	}
 
 	my $env = { "this" => "v" };
-	foreach my $e (@$es) {
-		foreach my $l (@{$e->{LEVELS}}) {
-			if ($l->{TYPE} eq "DATA") {
-				$env->{$e->{NAME}} = "v->$e->{NAME}";
-			} elsif ($l->{TYPE} eq "POINTER") {
-				$env->{"ptr_$e->{NAME}"} = "v->ptr_$e->{NAME}";
-			} elsif ($l->{TYPE} eq "SWITCH") {
-				$env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
-			} elsif ($l->{TYPE} eq "ARRAY") {
-				$env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
-			}
-		}
-	}
+	GenerateEnvElement($_, $env) foreach (@$es);
 
 	pidl "BOOL $ifn($s *v$args)";
 	pidl "{";
@@ -192,7 +205,7 @@ sub CreateStruct($$$$$)
 	pidl "prs_debug(ps, depth, desc, \"$fn\");";
 	pidl "depth++;";
 	if ($a > 0) {
-		pidl "if (!prs_align(ps, $a))";
+		pidl "if (!prs_align_custom(ps, $a))";
 		pidl "\treturn False;";
 		pidl "";
 	}
@@ -229,7 +242,7 @@ sub ParseUnion($$$)
 	pidl "{";
 	indent;
 	DeclareArrayVariables($u->{ELEMENTS});
-	pidl "if (!prs_align(ps, $u->{ALIGN}))";
+	pidl "if (!prs_align_custom(ps, $u->{ALIGN}))";
 	pidl "\treturn False;";
 	pidl "";
 
@@ -241,7 +254,9 @@ sub ParseUnion($$$)
 		indent;
 		if ($_->{TYPE} ne "EMPTY") {
 			pidl "depth++;";
-			ParseElement($_, {});
+			my $env = {};
+			GenerateEnvElement($_, $env);
+			ParseElement($_, $env);
 			pidl "depth--;";
 		}
 		pidl "break;";
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
index c09246e5a9..a3bf91d54f 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
@@ -53,6 +53,26 @@ sub decl_string($)
 	die("Don't know what string type to use");
 }
 
+sub contains_pointer($)
+{
+	my $e = shift;
+	
+	foreach my $l (@{$e->{LEVELS}}) { 
+		return 1 if ($l->{TYPE} eq "POINTER");
+	}
+
+	return 0;
+}
+
+sub ext_decl_string($)
+{
+	my $e = shift;
+
+	# One pointer is sufficient..
+	return "const char" if (contains_pointer($e));
+	return "const char *";
+}
+
 sub init_string($$$$)
 {
 	my ($e,$l,$n,$v) = @_;
@@ -67,6 +87,9 @@ sub init_string($$$$)
 	} else {
 		$flags = "UNI_FLAGS_NONE";
 	}
+
+	# One pointer is sufficient
+	if (substr($v, 0, 1) eq "*") { $v = substr($v, 1); }
 	
 	return "init_$t(&$n, $v, $flags);";
 }
@@ -77,7 +100,7 @@ sub dissect_string($$$)
 
 	my $t = lc(decl_string($e));
 
-	return "prs_$t(True, \"$e->{NAME}\", ps, depth, &n)";
+	return "prs_$t(True, \"$e->{NAME}\", ps, depth, &$n)";
 }
 
 my $known_types = 
@@ -109,6 +132,7 @@ my $known_types =
 	string => 
 	{
 		DECL => \&decl_string,
+		EXT_DECL => \&ext_decl_string,
 		INIT => \&init_string,
 		DISSECT => \&dissect_string,
 	},
@@ -175,6 +199,14 @@ sub GetType($)
 {
 	my $e = shift;
 
+}
+
+# Return type without special stuff, as used in 
+# declarations for internal structs
+sub DeclShort($)
+{
+	my $e = shift;
+
 	my $t = $known_types->{$e->{TYPE}};
 
 	if (not $t) {
@@ -182,41 +214,66 @@ sub GetType($)
 		return undef;
 	}
 
+	my $p;
+
 	# DECL can be a function
 	if (ref($t->{DECL}) eq "CODE") {
-		return $t->{DECL}->($e);
+		$p = $t->{DECL}->($e);
 	} else {
-		return $t->{DECL};
+		$p = $t->{DECL};
 	}
-}
 
-# Return type without special stuff, as used in 
-# struct declarations
-sub DeclShort($)
-{
-	my $e = shift;
-
-	my $t = GetType($e);
-	return undef if not $t;
+	my $prefixes = "";
+	my $suffixes = "";
+	foreach my $l (@{$e->{LEVELS}}) {
+		if ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) {
+			$prefixes = "*$prefixes";
+		} elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) {
+			$suffixes.="[$l->{SIZE_IS}]";
+		}
+	}
 	
-	return "$t $e->{NAME}";
+	return "$p $prefixes$e->{NAME}$suffixes";
 }
 
+# Return type including special stuff (pointers, etc).
 sub DeclLong($)
 {
 	my $e = shift;
 
-	my $t = GetType($e);
+	my $t = $known_types->{$e->{TYPE}};
+
+	if (not $t) {
+		warning($e, "Can't declare unknown type $e->{TYPE}");
+		return undef;
+	}
+
+	my $p;
 
-	return undef if not $t;
+	if (defined($t->{EXT_DECL})) {
+		$p = $t->{EXT_DECL}
+	} else {
+		$p = $t->{DECL};
+	}
 
-	my $ptrs = "";
+	if (ref($p) eq "CODE") {
+		$p = $p->($e);
+	}
+
+	my $prefixes = "";
+	my $suffixes = "";
 
 	foreach my $l (@{$e->{LEVELS}}) {
-		($ptrs.="*") if ($l->{TYPE} eq "POINTER");
+		if ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) {
+			$prefixes = "*$prefixes";
+		} elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) {
+			$suffixes.="[$l->{SIZE_IS}]";
+		} elsif ($l->{TYPE} eq "POINTER") {
+			$prefixes = "*$prefixes";
+		}
 	}
 	
-	return "$t $ptrs$e->{NAME}";
+	return "$p $prefixes$e->{NAME}$suffixes";
 }
 
 sub InitType($$$$)
@@ -238,9 +295,12 @@ sub InitType($$$$)
 	}
 }
 
-sub DissectType($$$)
+sub DissectType
 {
-	my ($e, $l, $varname) = @_;
+	my @args = @_;
+	my $e = shift @_;
+	my $l = shift @_;
+	my $varname = shift @_;
 
 	my $t = $known_types->{$l->{DATA_TYPE}};
 
@@ -251,7 +311,7 @@ sub DissectType($$$)
 
 	# DISSECT can be a function
 	if (ref($t->{DISSECT}) eq "CODE") {
-		return $t->{DISSECT}->($e, $l, $varname);
+		return $t->{DISSECT}->(@args);
 	} else {
 		return $t->{DISSECT};
 	}
@@ -264,17 +324,31 @@ sub LoadTypes($)
 		next unless ($if->{TYPE} eq "INTERFACE");
 
 		foreach my $td (@{$if->{TYPEDEFS}}) {
-			AddType($td->{NAME}, {
-				DECL => uc("$if->{NAME}_$td->{NAME}"),
-				INIT => sub {
+			my $decl = uc("$if->{NAME}_$td->{NAME}");
+			my $init = sub {
 					my ($e,$l,$n,$v) = @_;
 					return "$n = $v;";
-				},
-				DISSECT => sub {
+			};
+			
+			my $dissect;
+			if ($td->{DATA}->{TYPE} eq "UNION") {
+				 $dissect = sub {
+					my ($e,$l,$n,$s) = @_;
+
+					return "$if->{NAME}_io_$td->{NAME}(\"$e->{NAME}\", &$n, $s, ps, depth)";
+				};
+			} else {
+				 $dissect = sub {
 					my ($e,$l,$n) = @_;
 
 					return "$if->{NAME}_io_$td->{NAME}(\"$e->{NAME}\", &$n, ps, depth)";
-				}
+				};
+			}
+
+			AddType($td->{NAME}, {
+				DECL => $decl,
+				INIT => $init,
+				DISSECT => $dissect			
 			});
 		}
 	}