r10713: Couple more updates to the Samba3 parser generators.

Unions and enums have been improved, init functions are now generated
properly, some other small improvements.
(This used to be commit 8a60e79175eb27ef9fa4b8dea72a518bbaab900f)

5 files changed, 300 insertions, 90 deletions

diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
index 59d048176f..83762719ea 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Client.pm
@@ -9,7 +9,7 @@ use strict;
 use Parse::Pidl::Typelist qw(hasType getType mapType);
 use Parse::Pidl::Util qw(has_property ParseExpr);
 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
-use Parse::Pidl::Samba3::Util qw(MapSamba3Type);
+use Parse::Pidl::Samba3::Types qw(DeclLong);
 
 use vars qw($VERSION);
 $VERSION = '0.01';
@@ -28,7 +28,7 @@ sub ParseFunction($$)
 	my $args = "";
 	my $defargs = "";
 	foreach (@{$fn->{ELEMENTS}}) {
-		$defargs .= ", " . MapSamba3Type($_);
+		$defargs .= ", " . DeclLong($_);
 		$args .= ", $_->{NAME}";
 	}
 
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
index be7f1ca5c4..13f506a7da 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm
@@ -9,7 +9,7 @@ use strict;
 use Parse::Pidl::Typelist qw(hasType getType);
 use Parse::Pidl::Util qw(has_property ParseExpr);
 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
-use Parse::Pidl::Samba3::Util qw(MapSamba3Type);
+use Parse::Pidl::Samba3::Types qw(DeclShort);
 
 use vars qw($VERSION);
 $VERSION = '0.01';
@@ -17,24 +17,30 @@ $VERSION = '0.01';
 my $res = "";
 sub pidl($) { my $x = shift; $res .= "$x\n"; }
 sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
+sub warning($$) { my ($e,$s) = @_; warn("$e->{FILE}:$e->{LINE}: $s\n"); }
+
+sub ParseElement($)
+{
+	my $e = shift;
+
+	foreach my $l (@{$e->{LEVELS}}) {
+		if ($l->{TYPE} eq "POINTER") {
+			return if ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "top");
+			pidl "\tuint32 ptr_$e->{NAME};";
+		} elsif ($l->{TYPE} eq "SWITCH") {
+			pidl "\tuint32 level_$e->{NAME};";
+		} elsif ($l->{TYPE} eq "DATA") {
+			pidl "\t" . DeclShort($e) . ";";
+		}
+	}
+}
 
 sub CreateStruct($$$$)
 {
 	my ($if,$fn,$n,$t) = @_;
 
 	pidl "typedef struct $n {";
-	foreach my $e (@$t) {
-		foreach my $l (@{$e->{LEVELS}}) {
-			if ($l->{TYPE} eq "POINTER") {
-				return if ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "top");
-				pidl "\tuint32 ptr_$e->{NAME};";
-			} elsif ($l->{TYPE} eq "SWITCH") {
-				pidl "\tuint32 level_$e->{NAME};";
-			} elsif ($l->{TYPE} eq "DATA") {
-				pidl "\t" . MapSamba3Type($e) . ";";
-			}
-		}
-	}
+	ParseElement($_) foreach (@$t);
 
 	if (not @$t) {
 		# Some compilers don't like empty structs
@@ -83,16 +89,23 @@ sub ParseStruct($$$)
 	CreateStruct($if, $s, "$if->{NAME}_$n", $s->{ELEMENTS});
 }
 
+sub ParseUnion($$$)
+{
+	my ($if,$u,$n) = @_;
+
+	pidl "typedef union {";
+	#FIXME: What about elements that require more then one variable?
+	ParseElement($_) foreach (@{$u->{ELEMENTS}});
+	pidl "} $n;";
+	pidl "";
+}
+
 sub ParseEnum($$$)
 {
 	my ($if,$s,$n) = @_;
 
 	pidl "typedef enum {";
-
-	foreach (@{$s->{ELEMENTS}}) {
-		pidl "$_,";
-	}
-
+	pidl "$_," foreach (@{$s->{ELEMENTS}});
 	pidl "} $n;";
 }
 
@@ -122,15 +135,15 @@ sub ParseInterface($)
 
 	pidl "";
 
-	ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
-
 	foreach (@{$if->{TYPEDEFS}}) {
-		ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "STRUCT");
-		ParseEnum($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "ENUM");
-		ParseBitmap($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "BITMAP");
-		fatal($_, "Unions not supported for Samba3 yet") if ($_->{TYPE} eq "STRUCT");
+		ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
+		ParseEnum($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "ENUM");
+		ParseBitmap($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "BITMAP");
+		ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
 	}
 
+	ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
+
 	foreach (@{$if->{CONSTS}}) {
 		pidl "$_->{NAME} ($_->{VALUE})";
 	}
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
index 8518537ddb..5caab5da0c 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
@@ -9,7 +9,7 @@ use strict;
 use Parse::Pidl::Typelist qw(hasType getType mapType);
 use Parse::Pidl::Util qw(has_property ParseExpr);
 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
-use Parse::Pidl::Samba3::Util qw(MapSamba3Type);
+use Parse::Pidl::Samba3::Types qw(DeclShort DeclLong InitType DissectType);
 
 use vars qw($VERSION);
 $VERSION = '0.01';
@@ -21,24 +21,40 @@ sub deindent() { $tabs = substr($tabs, 1); }
 sub pidl($) { $res .= $tabs.(shift)."\n"; }
 sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
 
+#TODO:
+# - Different scalars / buffers functions for arrays + unions
+# - Register own types with Types::AddType()
+# - Find external types somehow?
+
+sub DeclareArrayVariables($)
+{
+	my $es = shift;
+
+	foreach my $e (@$es) {
+		foreach my $l (@{$e->{LEVELS}}) {
+			if ($l->{TYPE} eq "ARRAY") {
+				pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};";
+			}
+		}
+	}
+}
+
 sub ParseElementLevelData($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
-	#FIXME: This only works for scalar types
-	pidl "if (!prs_$l->{DATA_TYPE}(\"$e->{NAME}\", ps, depth, &$varname))";
+	pidl "if (!".DissectType($e, $l, $varname).")";
 	pidl "\treturn False;";
-	pidl "";
 }
 
 sub ParseElementLevelArray($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
-	#FIXME
-	pidl "for (i=0; i<".ParseExpr("length_$e->{NAME}", $env) .";i++) {";
+	my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}";
+	pidl "for ($i=0; $i<".ParseExpr("length_$e->{NAME}", $env) .";$i++) {";
 	indent;
-	ParseElementLevel($e,$nl,$env,"$varname\[i]");
+	ParseElementLevel($e,$nl,$env,$varname."[$i]");
 	deindent;
 	pidl "}";
 }
@@ -58,8 +74,9 @@ sub ParseElementLevelPtr($$$$$)
 {
 	my ($e,$l,$nl,$env,$varname) = @_;
 
-	# No top-level ref pointers for Samba 3
-	return if ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP");
+	if ($l->{POINTER_TYPE} eq "relative") {
+		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 "\treturn False;";
@@ -99,24 +116,65 @@ sub ParseElement($$)
 	ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env));
 }
 
-sub CreateStruct($$$)
+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);
+		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 "}";
+	} elsif ($l->{TYPE} eq "DATA") {
+		pidl InitType($e, $l, $varname, $varname);
+	} elsif ($l->{TYPE} eq "SWITCH") {
+		InitLevel($e, GetNextLevel($e,$l), $varname, $env);
+	}
+}
+
+sub CreateStruct($$$$)
 {
-	my ($fn,$s,$es) = @_;
+	my ($fn,$s,$es,$a) = @_;
 
 	my $args = "";
 	foreach my $e (@$es) {
-		$args .= ", " . MapSamba3Type($_);
+		$args .= ", " . DeclLong($_);
+	}
+
+	my $env = {};
+	foreach my $e (@$es) {
+		foreach my $l (@{$e->{LEVELS}}) {
+			if ($l->{TYPE} eq "DATA") {
+				$env->{"$e->{NAME}"} = $e->{"v->$e->{NAME}"};
+			} elsif ($l->{TYPE} eq "POINTER") {
+				$env->{"ptr_$e->{NAME}"} = $e->{"v->ptr_$e->{NAME}"};
+			} elsif ($l->{TYPE} eq "SWITCH") {
+				$env->{"level_$e->{NAME}"} = $e->{"v->level_$e->{NAME}"};
+			} 
+		}
 	}
 
 	pidl "BOOL init_$fn($s *v$args)";
 	pidl "{";
 	indent;
 	pidl "DEBUG(5,(\"init_$fn\\n\"));";
+	pidl "";
 	# Call init for all arguments
-	foreach my $e (@$es) {
-		foreach my $l (@{$e->{LEVELS}}) {
-			#FIXME
-		}
+	foreach (@$es) {
+		InitLevel($_, $_->{LEVELS}[0], ParseExpr($_->{NAME}, $env), $env);
+		pidl "";
 	}
 	pidl "return True;";
 	deindent;
@@ -126,29 +184,22 @@ sub CreateStruct($$$)
 	pidl "BOOL $fn(const char *desc, $s *v, prs_struct *ps, int depth)";
 	pidl "{";
 	indent;
+	DeclareArrayVariables($es);
 	pidl "if (v == NULL)";
 	pidl "\treturn False;";
 	pidl "";
 	pidl "prs_debug(ps, depth, desc, \"$fn\");";
 	pidl "depth++;";
-	pidl "if (!prs_align(ps))";
-	pidl "\treturn False;";
-	pidl "";
-
-	my $env = {};
-	foreach my $e (@$es) {
-		foreach my $l (@{$e->{LEVELS}}) {
-			if ($l->{TYPE} eq "DATA") {
-				$env->{"$e->{NAME}"} = $e->{"v->$e->{NAME}"};
-			} elsif ($l->{TYPE} eq "POINTER") {
-				$env->{"ptr_$e->{NAME}"} = $e->{"v->ptr_$e->{NAME}"};
-			} elsif ($l->{TYPE} eq "SWITCH") {
-				$env->{"level_$e->{NAME}"} = $e->{"v->level_$e->{NAME}"};
-			} 
-		}
+	if ($a > 0) {
+		pidl "if (!prs_align(ps, $a))";
+		pidl "\treturn False;";
+		pidl "";
 	}
 
-	ParseElement($_, $env) foreach (@$es);
+	foreach (@$es) {
+		ParseElement($_, $env);
+		pidl "";
+	}
 
 	pidl "return True;";
 	deindent;
@@ -163,7 +214,7 @@ sub ParseStruct($$$)
 	my $fn = "$if->{NAME}_io_$n";
 	my $sn = uc("$if->{NAME}_$n");
 
-	CreateStruct($fn, $sn, $s->{ELEMENTS});
+	CreateStruct($fn, $sn, $s->{ELEMENTS}, $s->{ALIGN});
 }
 
 sub ParseUnion($$$)
@@ -176,6 +227,11 @@ sub ParseUnion($$$)
 	pidl "BOOL $fn(const char *desc, $sn* v, uint32 level, prs_struct *ps, int depth)";
 	pidl "{";
 	indent;
+	DeclareArrayVariables($u->{ELEMENTS});
+	pidl "if (!prs_align(ps, $u->{ALIGN}))";
+	pidl "\treturn False;";
+	pidl "";
+
 	pidl "switch (level) {";
 	indent;
 
@@ -187,6 +243,7 @@ sub ParseUnion($$$)
 		deindent;
 		pidl "depth--;";
 		pidl "break";
+		pidl "";
 	}
 
 	deindent;
@@ -222,8 +279,8 @@ sub ParseFunction($$)
 		} );
 	}
 
-	CreateStruct("$if->{NAME}_io_q_$fn->{NAME}", uc("$if->{NAME}_q_$fn->{NAME}"), \@in);
-	CreateStruct("$if->{NAME}_io_r_$fn->{NAME}", uc("$if->{NAME}_r_$fn->{NAME}"), \@out);
+	CreateStruct("$if->{NAME}_io_q_$fn->{NAME}", uc("$if->{NAME}_q_$fn->{NAME}"), \@in, 0);
+	CreateStruct("$if->{NAME}_io_r_$fn->{NAME}", uc("$if->{NAME}_r_$fn->{NAME}"), \@out, 0);
 }
 
 sub ParseInterface($)
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
new file mode 100644
index 0000000000..68bea0d024
--- /dev/null
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
@@ -0,0 +1,169 @@
+###################################################
+# Samba3 common helper functions
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl::Samba3::Types;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(DeclShort DeclLong InitType DissectType AddType);
+
+use strict;
+use Parse::Pidl::Util qw(has_property ParseExpr);
+use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+sub init_scalar($$$$)
+{
+	my ($e,$l,$n,$v) = @_;
+
+	return "$n = $v;";
+}
+
+sub dissect_scalar($$$)
+{
+	my ($e,$l,$n) = @_;
+
+	my $t = lc($e->{TYPE});
+	
+	return "prs_$t(\"$e->{NAME}\", ps, depth, &$n)";
+}
+
+sub decl_string($)
+{
+	my $e = shift;
+
+	return "UNISTR2";
+}
+
+sub init_string($$$$)
+{
+	my ($e,$l,$n,$v) = @_;
+	
+	return "init_unistr2(&$n, $v, UNI_FLAGS_NONE);";
+}
+
+sub dissect_string($$$)
+{
+	my ($e,$l,$n) = @_;
+
+	return "FIXME";
+}
+
+my $known_types = {
+	uint8 => {
+		DECL => "uint8",
+		INIT => \&init_scalar,
+		DISSECT => \&dissect_scalar,
+	},
+	uint16 => {
+		DECL => "uint16",
+		INIT => \&init_scalar,
+		DISSECT => \&dissect_scalar,
+	},
+	uint32 => {
+		DECL => "uint32",
+		INIT => \&init_scalar,
+		DISSECT => \&dissect_scalar,
+	},
+	string => {
+		DECL => \&decl_string,
+		INIT => \&init_string,
+		DISSECT => \&dissect_string,
+	},
+	NTSTATUS => {
+		DECL => "NTSTATUS",
+		INIT => \&init_scalar,
+		DISSECT => \&dissect_scalar,
+	},
+	WERROR => {
+		DECL => "WERROR",
+		INIT => \&init_scalar,
+		DISSECT => \&dissect_scalar,
+	},
+};
+
+sub AddType($$)
+{
+	my ($t,$d) = @_;
+
+	warn("Reregistering type $t") if (defined($known_types->{$t}));
+
+	$known_types->{$t} = $d;
+}
+
+sub GetType($)
+{
+	my $e = shift;
+
+	my $t = $known_types->{$e->{TYPE}};
+
+	return undef if not $t;
+
+	# DECL can be a function
+	if (ref($t->{DECL}) eq "CODE") {
+		return $t->{DECL}->($e);
+	} else {
+		return $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;
+	
+	return "$t $e->{NAME}";
+}
+
+sub DeclLong($)
+{
+	my $e = shift;
+
+	my $t = GetType($e);
+
+	return undef if not $t;
+
+	return "$t $e->{NAME}";
+}
+
+sub InitType($$$$)
+{
+	my ($e, $l, $varname, $value) = @_;
+
+	my $t = $known_types->{$l->{DATA_TYPE}};
+
+	return undef if not $t;
+
+	# INIT can be a function
+	if (ref($t->{INIT}) eq "CODE") {
+		return $t->{INIT}->($e, $l, $varname, $value);
+	} else {
+		return $t->{INIT};
+	}
+}
+
+sub DissectType($$$)
+{
+	my ($e, $l, $varname) = @_;
+
+	my $t = $known_types->{$l->{DATA_TYPE}};
+
+	return undef if not $t;
+
+	# DISSECT can be a function
+	if (ref($t->{DISSECT}) eq "CODE") {
+		return $t->{DISSECT}->($e, $l, $varname);
+	} else {
+		return $t->{DISSECT};
+	}
+}
+
+1;
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Util.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Util.pm
deleted file mode 100644
index 2d4179df76..0000000000
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Util.pm
+++ /dev/null
@@ -1,29 +0,0 @@
-###################################################
-# Samba3 common helper functions
-# Copyright jelmer@samba.org 2005
-# released under the GNU GPL
-
-package Parse::Pidl::Samba3::Util;
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(MapSamba3Type);
-
-use strict;
-use Parse::Pidl::Typelist qw(hasType getType mapType);
-use Parse::Pidl::Util qw(has_property ParseExpr);
-use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
-
-use vars qw($VERSION);
-$VERSION = '0.01';
-
-sub MapSamba3Type($)
-{
-	my $e = shift;
-	
-	return "UNISTR2 $e->{NAME}"  if ($e->{TYPE} eq "string");
-
-	return "$e->{TYPE} $e->{NAME}";
-}
-
-1;