r10715: More Samba3 parser generator improvements:

- Actually generate parsers for unions and structs.
- Support some more builtin types.
- Some more work on supporting arrays.
- Several other small fixes.

I've updated the example output at http://samba.org/~jelmer/
(This used to be commit b229c033ebc7ec972b32f1b75b60a9c68a36db97)

2 files changed, 104 insertions, 30 deletions

diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
index 5caab5da0c..57ee1543ff 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
@@ -23,8 +23,7 @@ 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?
+# - Memory allocation for arrays?
 
 sub DeclareArrayVariables($)
 {
@@ -78,7 +77,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) . ", ps, depth))";
 	pidl "\treturn False;";
 	pidl "";
 	
@@ -138,7 +137,7 @@ sub InitLevel($$$$)
 		deindent;
 		pidl "}";
 	} elsif ($l->{TYPE} eq "DATA") {
-		pidl InitType($e, $l, $varname, $varname);
+		pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
 	} elsif ($l->{TYPE} eq "SWITCH") {
 		InitLevel($e, GetNextLevel($e,$l), $varname, $env);
 	}
@@ -149,20 +148,22 @@ sub CreateStruct($$$$)
 	my ($fn,$s,$es,$a) = @_;
 
 	my $args = "";
-	foreach my $e (@$es) {
+	foreach (@$es) {
 		$args .= ", " . DeclLong($_);
 	}
 
-	my $env = {};
+	my $env = { "this" => "v" };
 	foreach my $e (@$es) {
 		foreach my $l (@{$e->{LEVELS}}) {
 			if ($l->{TYPE} eq "DATA") {
-				$env->{"$e->{NAME}"} = $e->{"v->$e->{NAME}"};
+				$env->{$e->{NAME}} = "v->$e->{NAME}";
 			} elsif ($l->{TYPE} eq "POINTER") {
-				$env->{"ptr_$e->{NAME}"} = $e->{"v->ptr_$e->{NAME}"};
+				$env->{"ptr_$e->{NAME}"} = "v->ptr_$e->{NAME}";
 			} elsif ($l->{TYPE} eq "SWITCH") {
-				$env->{"level_$e->{NAME}"} = $e->{"v->level_$e->{NAME}"};
-			} 
+				$env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
+			} elsif ($l->{TYPE} eq "ARRAY") {
+				$env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
+			}
 		}
 	}
 
@@ -173,7 +174,7 @@ sub CreateStruct($$$$)
 	pidl "";
 	# Call init for all arguments
 	foreach (@$es) {
-		InitLevel($_, $_->{LEVELS}[0], ParseExpr($_->{NAME}, $env), $env);
+		InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
 		pidl "";
 	}
 	pidl "return True;";
@@ -238,11 +239,13 @@ sub ParseUnion($$$)
 	foreach (@{$u->{ELEMENTS}}) {
 		pidl "$_->{CASE}:";
 		indent;
-		pidl "depth++;";
-		ParseElement($_, {});
+		if ($_->{TYPE} ne "EMPTY") {
+			pidl "depth++;";
+			ParseElement($_, {});
+			pidl "depth--;";
+		}
+		pidl "break;";
 		deindent;
-		pidl "depth--;";
-		pidl "break";
 		pidl "";
 	}
 
@@ -290,8 +293,8 @@ sub ParseInterface($)
 	# Structures first 
 	pidl "/* $if->{NAME} structures */";
 	foreach (@{$if->{TYPEDEFS}}) {
-		ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "STRUCT");
-		ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "UNION");
+		ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
+		ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
 	}
 
 	pidl "/* $if->{NAME} functions */";
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
index 68bea0d024..b9d969216c 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
@@ -1,5 +1,5 @@
 ###################################################
-# Samba3 common helper functions
+# Samba3 type-specific declarations / initialization / marshalling
 # Copyright jelmer@samba.org 2005
 # released under the GNU GPL
 
@@ -16,6 +16,10 @@ use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
 use vars qw($VERSION);
 $VERSION = '0.01';
 
+# TODO: Find external types somehow?
+
+sub warning($$) { my ($e,$s) = @_; print STDERR "$e->{FILE}:$e->{LINE}: $s\n"; }
+
 sub init_scalar($$$$)
 {
 	my ($e,$l,$n,$v) = @_;
@@ -36,6 +40,8 @@ sub decl_string($)
 {
 	my $e = shift;
 
+	# FIXME: More intelligent code here - select between UNISTR2 and other
+	# variants
 	return "UNISTR2";
 }
 
@@ -50,40 +56,67 @@ sub dissect_string($$$)
 {
 	my ($e,$l,$n) = @_;
 
-	return "FIXME";
+	return "prs_unistr2(True, \"$e->{NAME}\", ps, depth, &n)";
+}
+
+sub init_uuid($$$$)
+{
+	my ($e,$l,$n,$v) = @_;
+
+	return "";
+}
+
+sub dissect_uuid($$$)
+{
+	my ($e,$l,$n) = @_;
+
+	return "smb_io_uuid(\"$e->{NAME}\", &$n, ps, depth)";
 }
 
-my $known_types = {
-	uint8 => {
+my $known_types = 
+{
+	uint8 => 
+	{
 		DECL => "uint8",
 		INIT => \&init_scalar,
 		DISSECT => \&dissect_scalar,
 	},
-	uint16 => {
+	uint16 => 
+	{
 		DECL => "uint16",
 		INIT => \&init_scalar,
 		DISSECT => \&dissect_scalar,
 	},
-	uint32 => {
+	uint32 => 
+	{
 		DECL => "uint32",
 		INIT => \&init_scalar,
 		DISSECT => \&dissect_scalar,
 	},
-	string => {
+	string => 
+	{
 		DECL => \&decl_string,
 		INIT => \&init_string,
 		DISSECT => \&dissect_string,
 	},
-	NTSTATUS => {
+	NTSTATUS => 
+	{
 		DECL => "NTSTATUS",
 		INIT => \&init_scalar,
 		DISSECT => \&dissect_scalar,
 	},
-	WERROR => {
+	WERROR => 
+	{
 		DECL => "WERROR",
 		INIT => \&init_scalar,
 		DISSECT => \&dissect_scalar,
 	},
+	GUID => 
+	{
+		DECL => "struct uuid",
+		INIT => \&init_uuid,
+		DISSECT => \&dissect_uuid,
+	}
 };
 
 sub AddType($$)
@@ -101,7 +134,10 @@ sub GetType($)
 
 	my $t = $known_types->{$e->{TYPE}};
 
-	return undef if not $t;
+	if (not $t) {
+		warning($e, "Can't declare unknown type $e->{TYPE}");
+		return undef;
+	}
 
 	# DECL can be a function
 	if (ref($t->{DECL}) eq "CODE") {
@@ -131,7 +167,13 @@ sub DeclLong($)
 
 	return undef if not $t;
 
-	return "$t $e->{NAME}";
+	my $ptrs = "";
+
+	foreach my $l (@{$e->{LEVELS}}) {
+		($ptrs.="*") if ($l->{TYPE} eq "POINTER");
+	}
+	
+	return "$t $ptrs$e->{NAME}";
 }
 
 sub InitType($$$$)
@@ -140,7 +182,10 @@ sub InitType($$$$)
 
 	my $t = $known_types->{$l->{DATA_TYPE}};
 
-	return undef if not $t;
+	if (not $t) {
+		warning($e, "Don't know how to initialize type $l->{DATA_TYPE}");
+		return undef;
+	}
 
 	# INIT can be a function
 	if (ref($t->{INIT}) eq "CODE") {
@@ -156,7 +201,10 @@ sub DissectType($$$)
 
 	my $t = $known_types->{$l->{DATA_TYPE}};
 
-	return undef if not $t;
+	if (not $t) {
+		warning($e, "Don't know how to dissect type $l->{DATA_TYPE}");
+		return undef;
+	}
 
 	# DISSECT can be a function
 	if (ref($t->{DISSECT}) eq "CODE") {
@@ -166,4 +214,27 @@ sub DissectType($$$)
 	}
 }
 
+sub LoadTypes($)
+{
+	my $ndr = shift;
+	foreach my $if (@{$ndr}) {
+		next unless ($if->{TYPE} eq "INTERFACE");
+
+		foreach my $td (@{$if->{TYPEDEFS}}) {
+			AddType($td->{NAME}, {
+				DECL => uc("$if->{NAME}_$td->{NAME}"),
+				INIT => sub {
+					my ($e,$l,$n,$v) = @_;
+					return "init_$td->{NAME}(&$n/*FIXME:OTHER ARGS*/);";
+				},
+				DISSECT => sub {
+					my ($e,$l,$n) = @_;
+
+					return "$if->{NAME}_io_$td->{NAME}(\"$e->{NAME}\", &$n, ps, depth)";
+				}
+			});
+		}
+	}
+}
+
 1;