diff options
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm | 4 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm | 2 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba4/Header.pm | 71 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm | 65 | ||||
-rwxr-xr-x | source4/pidl/tests/header.pl | 54 | ||||
-rwxr-xr-x | source4/pidl/tests/samba-ndr.pl | 51 | ||||
-rwxr-xr-x | source4/pidl/tests/samba3-cli.pl | 2 |
7 files changed, 130 insertions, 119 deletions
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm b/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm index b7372a802a..86b8951026 100644 --- a/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm +++ b/source4/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm @@ -9,7 +9,7 @@ package Parse::Pidl::Samba3::ClientNDR; use Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(GenerateFunctionInEnv ParseFunction $res $res_hdr); +@EXPORT_OK = qw(ParseFunction $res $res_hdr); use strict; use Parse::Pidl qw(fatal warning); @@ -17,7 +17,7 @@ use Parse::Pidl::Typelist qw(hasType getType mapTypeName scalar_is_reference); use Parse::Pidl::Util qw(has_property is_constant ParseExpr); use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred); use Parse::Pidl::Samba4 qw(DeclLong); -use Parse::Pidl::Samba4::NDR::Parser qw(GenerateFunctionInEnv); +use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv); use vars qw($VERSION); $VERSION = '0.01'; diff --git a/source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm b/source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm index 24270340b9..efb3f2858d 100644 --- a/source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm +++ b/source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm @@ -15,7 +15,7 @@ use Parse::Pidl::Typelist qw(typeHasBody); use Parse::Pidl::CUtil qw(get_pointer_to get_value_of); use Parse::Pidl::Util qw(has_property ParseExpr); use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel); -use Parse::Pidl::Samba4::NDR::Parser qw(GenerateStructEnv GenerateFunctionInEnv +use Parse::Pidl::Samba4::Header qw(GenerateStructEnv GenerateFunctionInEnv GenerateFunctionOutEnv); use vars qw($VERSION); diff --git a/source4/pidl/lib/Parse/Pidl/Samba4/Header.pm b/source4/pidl/lib/Parse/Pidl/Samba4/Header.pm index b96a58783c..06e9ec4b9f 100644 --- a/source4/pidl/lib/Parse/Pidl/Samba4/Header.pm +++ b/source4/pidl/lib/Parse/Pidl/Samba4/Header.pm @@ -6,10 +6,15 @@ package Parse::Pidl::Samba4::Header; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT_OK = qw(GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv); + use strict; use Parse::Pidl qw(fatal); use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference); -use Parse::Pidl::Util qw(has_property is_constant unmake_str); +use Parse::Pidl::Util qw(has_property is_constant unmake_str ParseExpr); use Parse::Pidl::Samba4 qw(is_intree ElementStars ArrayBrackets choose_header); use vars qw($VERSION); @@ -406,4 +411,68 @@ sub Parse($) return $res; } +sub GenerateStructEnv($$) +{ + my ($x, $v) = @_; + my %env; + + foreach my $e (@{$x->{ELEMENTS}}) { + $env{$e->{NAME}} = "$v->$e->{NAME}"; + } + + $env{"this"} = $v; + + return \%env; +} + +sub EnvSubstituteValue($$) +{ + my ($env,$s) = @_; + + # Substitute the value() values in the env + foreach my $e (@{$s->{ELEMENTS}}) { + next unless (defined(my $v = has_property($e, "value"))); + + $env->{$e->{NAME}} = ParseExpr($v, $env, $e); + } + + return $env; +} + +sub GenerateFunctionInEnv($;$) +{ + my ($fn, $base) = @_; + my %env; + + $base = "r->" unless defined($base); + + foreach my $e (@{$fn->{ELEMENTS}}) { + if (grep (/in/, @{$e->{DIRECTION}})) { + $env{$e->{NAME}} = $base."in.$e->{NAME}"; + } + } + + return \%env; +} + +sub GenerateFunctionOutEnv($;$) +{ + my ($fn, $base) = @_; + my %env; + + $base = "r->" unless defined($base); + + foreach my $e (@{$fn->{ELEMENTS}}) { + if (grep (/out/, @{$e->{DIRECTION}})) { + $env{$e->{NAME}} = $base."out.$e->{NAME}"; + } elsif (grep (/in/, @{$e->{DIRECTION}})) { + $env{$e->{NAME}} = $base."in.$e->{NAME}"; + } + } + + return \%env; +} + + + 1; diff --git a/source4/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm index 8eb2f9ad15..0800a19fab 100644 --- a/source4/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm +++ b/source4/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm @@ -9,7 +9,7 @@ package Parse::Pidl::Samba4::NDR::Parser; require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(check_null_pointer GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv NeededFunction NeededElement NeededType $res NeededInterface TypeFunctionName ParseElementPrint); +@EXPORT_OK = qw(check_null_pointer NeededFunction NeededElement NeededType $res NeededInterface TypeFunctionName ParseElementPrint); use strict; use Parse::Pidl::Typelist qw(hasType getType mapTypeName typeHasBody); @@ -17,6 +17,7 @@ use Parse::Pidl::Util qw(has_property ParseExpr ParseExprExt print_uuid); use Parse::Pidl::CUtil qw(get_pointer_to get_value_of); use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred); use Parse::Pidl::Samba4 qw(is_intree choose_header); +use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv); use Parse::Pidl qw(warning); use vars qw($VERSION); @@ -193,68 +194,6 @@ sub end_flags($$) } } -sub GenerateStructEnv($$) -{ - my ($x, $v) = @_; - my %env; - - foreach my $e (@{$x->{ELEMENTS}}) { - $env{$e->{NAME}} = "$v->$e->{NAME}"; - } - - $env{"this"} = $v; - - return \%env; -} - -sub EnvSubstituteValue($$) -{ - my ($env,$s) = @_; - - # Substitute the value() values in the env - foreach my $e (@{$s->{ELEMENTS}}) { - next unless (defined(my $v = has_property($e, "value"))); - - $env->{$e->{NAME}} = ParseExpr($v, $env, $e); - } - - return $env; -} - -sub GenerateFunctionInEnv($;$) -{ - my ($fn, $base) = @_; - my %env; - - $base = "r->" unless defined($base); - - foreach my $e (@{$fn->{ELEMENTS}}) { - if (grep (/in/, @{$e->{DIRECTION}})) { - $env{$e->{NAME}} = $base."in.$e->{NAME}"; - } - } - - return \%env; -} - -sub GenerateFunctionOutEnv($;$) -{ - my ($fn, $base) = @_; - my %env; - - $base = "r->" unless defined($base); - - foreach my $e (@{$fn->{ELEMENTS}}) { - if (grep (/out/, @{$e->{DIRECTION}})) { - $env{$e->{NAME}} = $base."out.$e->{NAME}"; - } elsif (grep (/in/, @{$e->{DIRECTION}})) { - $env{$e->{NAME}} = $base."in.$e->{NAME}"; - } - } - - return \%env; -} - ##################################################################### # parse the data of an array - push side sub ParseArrayPushHeader($$$$$$) diff --git a/source4/pidl/tests/header.pl b/source4/pidl/tests/header.pl index 8d0dccf507..db59484444 100755 --- a/source4/pidl/tests/header.pl +++ b/source4/pidl/tests/header.pl @@ -4,12 +4,14 @@ use strict; use warnings; -use Test::More tests => 16; +use Test::More tests => 27; use FindBin qw($RealBin); use lib "$RealBin"; use Util; use Parse::Pidl::Util qw(MyDumper); -use Parse::Pidl::Samba4::Header; +use Parse::Pidl::Samba4::Header qw( + GenerateFunctionInEnv GenerateFunctionOutEnv GenerateStructEnv + EnvSubstituteValue); use Parse::Pidl::IDL qw(parse_string); use Parse::Pidl::NDR; @@ -56,3 +58,51 @@ like(parse_idl("interface p { typedef struct x { int p; } x; };"), like(parse_idl("cpp_quote(\"some-foo\")"), qr/some-foo/sm, "cpp quote"); + +# Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work +my $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] }; +is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn)); + +$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] }; +is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn)); + +$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] }; +is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn)); + +$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] }; +is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn)); + +$fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] }; +is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionOutEnv($fn)); + +$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] }; +is_deeply({ }, GenerateFunctionInEnv($fn)); + +$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; +is_deeply({ foo => "r->foo", bar => "r->bar", this => "r" }, + GenerateStructEnv($fn, "r")); + +$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; +is_deeply({ foo => "some->complex.variable->foo", + bar => "some->complex.variable->bar", + this => "some->complex.variable" }, + GenerateStructEnv($fn, "some->complex.variable")); + +$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] }; + +my $env = GenerateStructEnv($fn, "r"); +EnvSubstituteValue($env, $fn); +is_deeply($env, { foo => 3, this => "r" }); + +$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; +$env = GenerateStructEnv($fn, "r"); +EnvSubstituteValue($env, $fn); +is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" }); + +$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] }; + +$env = GenerateStructEnv($fn, "r"); +EnvSubstituteValue($env, $fn); +is_deeply($env, { foo => 0, this => "r" }); + + diff --git a/source4/pidl/tests/samba-ndr.pl b/source4/pidl/tests/samba-ndr.pl index 05c3c1c0df..a14111961f 100755 --- a/source4/pidl/tests/samba-ndr.pl +++ b/source4/pidl/tests/samba-ndr.pl @@ -4,15 +4,14 @@ use strict; use warnings; -use Test::More tests => 41; +use Test::More tests => 30; use FindBin qw($RealBin); use lib "$RealBin"; use Util; use strict; use Parse::Pidl::Util qw(MyDumper); use Parse::Pidl::Samba4::NDR::Parser qw(check_null_pointer - GenerateFunctionInEnv GenerateFunctionOutEnv GenerateStructEnv - EnvSubstituteValue NeededFunction NeededElement NeededType + NeededFunction NeededElement NeededType NeededInterface TypeFunctionName ParseElementPrint); my $output; @@ -138,52 +137,6 @@ test_warnings("nofile:2: unknown dereferenced expression `r->in.bla'\n", is($output, "if (r->in.bla == NULL) return;"); -# Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work -$fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] }; -is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn)); - -$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] }; -is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn)); - -$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] }; -is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn)); - -$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] }; -is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn)); - -$fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] }; -is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionOutEnv($fn)); - -$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] }; -is_deeply({ }, GenerateFunctionInEnv($fn)); - -$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; -is_deeply({ foo => "r->foo", bar => "r->bar", this => "r" }, - GenerateStructEnv($fn, "r")); - -$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; -is_deeply({ foo => "some->complex.variable->foo", - bar => "some->complex.variable->bar", - this => "some->complex.variable" }, - GenerateStructEnv($fn, "some->complex.variable")); - -$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] }; - -my $env = GenerateStructEnv($fn, "r"); -EnvSubstituteValue($env, $fn); -is_deeply($env, { foo => 3, this => "r" }); - -$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] }; -$env = GenerateStructEnv($fn, "r"); -EnvSubstituteValue($env, $fn); -is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" }); - -$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] }; - -$env = GenerateStructEnv($fn, "r"); -EnvSubstituteValue($env, $fn); -is_deeply($env, { foo => 0, this => "r" }); - my $needed = {}; NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed); is_deeply($needed, { ndr_pull_foo => 1 }); diff --git a/source4/pidl/tests/samba3-cli.pl b/source4/pidl/tests/samba3-cli.pl index 1b2a3c9785..f5b51b7d34 100755 --- a/source4/pidl/tests/samba3-cli.pl +++ b/source4/pidl/tests/samba3-cli.pl @@ -10,7 +10,7 @@ use lib "$RealBin"; use Util; use Parse::Pidl::Util qw(MyDumper); use Parse::Pidl::Samba3::ClientNDR qw(ParseFunction); -use Parse::Pidl::Samba4::NDR::Parser qw(GenerateFunctionInEnv GenerateFunctionOutEnv); +use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv); # Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work my $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] }; |