source/pidl/tests/samba-ndr.pl

   1 #!/usr/bin/perl
   2 # (C) 2007 Jelmer Vernooij <jelmer@samba.org>
   3 # Published under the GNU General Public License
   4 use strict;
   5 use warnings;
   6
   7 use Test::More tests => 31;
   8 use FindBin qw($RealBin);
   9 use lib "$RealBin";
  10 use Util;
  11 use Parse::Pidl::Util qw(MyDumper);
  12 use Parse::Pidl::Samba4::NDR::Parser qw(check_null_pointer
  13         GenerateFunctionInEnv GenerateFunctionOutEnv GenerateStructEnv
  14         EnvSubstituteValue NeededFunction NeededElement NeededTypedef);
  15
  16 my $output;
  17 sub print_fn($) { my $x = shift; $output.=$x; }
  18
  19 # Test case 1: Simple unique pointer dereference
  20
  21 $output = "";
  22 my $fn = check_null_pointer({
  23         PARENT => {
  24                 ELEMENTS => [
  25                         {
  26                                 NAME => "bla",
  27                                 LEVELS => [
  28                                         { TYPE => "POINTER",
  29                                           POINTER_INDEX => 0,
  30                                           POINTER_TYPE => "unique" },
  31                                         { TYPE => "DATA" }
  32                                 ],
  33                         },
  34                 ]
  35         }
  36 }, { bla => "r->in.bla" }, \&print_fn, "return;");
  37
  38
  39 test_warnings("", sub { $fn->("r->in.bla"); });
  40
  41 is($output, "if (r->in.bla == NULL) return;");
  42
  43 # Test case 2: Simple ref pointer dereference
  44
  45 $output = "";
  46 $fn = check_null_pointer({
  47         PARENT => {
  48                 ELEMENTS => [
  49                         {
  50                                 NAME => "bla",
  51                                 LEVELS => [
  52                                         { TYPE => "POINTER",
  53                                           POINTER_INDEX => 0,
  54                                           POINTER_TYPE => "ref" },
  55                                         { TYPE => "DATA" }
  56                                 ],
  57                         },
  58                 ]
  59         }
  60 }, { bla => "r->in.bla" }, \&print_fn, undef);
  61
  62 test_warnings("", sub { $fn->("r->in.bla"); });
  63
  64 is($output, "");
  65
  66 # Test case 3: Illegal dereference
  67
  68 $output = "";
  69 $fn = check_null_pointer({
  70         FILE => "nofile",
  71         LINE => 1,
  72         PARENT => {
  73                 ELEMENTS => [
  74                         {
  75                                 NAME => "bla",
  76                                 LEVELS => [
  77                                         { TYPE => "DATA" }
  78                                 ],
  79                         },
  80                 ]
  81         }
  82 }, { bla => "r->in.bla" }, \&print_fn, undef);
  83
  84 test_warnings("nofile:1: too much dereferences for `bla'\n",
  85                   sub { $fn->("r->in.bla"); });
  86
  87 is($output, "");
  88
  89 # Test case 4: Double pointer dereference
  90
  91 $output = "";
  92 $fn = check_null_pointer({
  93         PARENT => {
  94                 ELEMENTS => [
  95                         {
  96                                 NAME => "bla",
  97                                 LEVELS => [
  98                                         { TYPE => "POINTER",
  99                                           POINTER_INDEX => 0,
 100                                           POINTER_TYPE => "unique" },
 101                                         { TYPE => "POINTER",
 102                                           POINTER_INDEX => 1,
 103                                           POINTER_TYPE => "unique" },
 104                                         { TYPE => "DATA" }
 105                                 ],
 106                         },
 107                 ]
 108         }
 109 }, { bla => "r->in.bla" }, \&print_fn, "return;");
 110
 111 test_warnings("",
 112                   sub { $fn->("*r->in.bla"); });
 113
 114 is($output, "if (*r->in.bla == NULL) return;");
 115
 116 # Test case 5: Unknown variable
 117
 118 $output = "";
 119 $fn = check_null_pointer({
 120         FILE => "nofile",
 121         LINE => 2,
 122         PARENT => {
 123                 ELEMENTS => [
 124                         {
 125                                 NAME => "bla",
 126                                 LEVELS => [
 127                                         { TYPE => "DATA" }
 128                                 ],
 129                         },
 130                 ]
 131         }
 132 }, { }, \&print_fn, "return;");
 133
 134 test_warnings("nofile:2: unknown dereferenced expression `r->in.bla'\n",
 135                   sub { $fn->("r->in.bla"); });
 136
 137 is($output, "if (r->in.bla == NULL) return;");
 138
 139 # Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work
 140 $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
 141 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
 142
 143 $fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
 144 is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
 145
 146 $fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
 147 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
 148
 149 $fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
 150 is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
 151
 152 $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
 153 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionOutEnv($fn));
 154
 155 $fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
 156 is_deeply({ }, GenerateFunctionInEnv($fn));
 157
 158 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 159 is_deeply({ foo => "r->foo", bar => "r->bar", this => "r" }, GenerateStructEnv($fn));
 160
 161 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] };
 162
 163 my $env = GenerateStructEnv($fn);
 164 EnvSubstituteValue($env, $fn);
 165 is_deeply($env, { foo => 3, this => "r" });
 166
 167 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 168 $env = GenerateStructEnv($fn);
 169 EnvSubstituteValue($env, $fn);
 170 is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" });
 171
 172 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] };
 173
 174 $env = GenerateStructEnv($fn);
 175 EnvSubstituteValue($env, $fn);
 176 is_deeply($env, { foo => 0, this => "r" });
 177
 178 my $needed = {};
 179 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 180 is_deeply($needed, { pull_foo => 1 });
 181
 182 # old settings should be kept
 183 $needed = { pull_foo => 0 };
 184 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 185 is_deeply($needed, { pull_foo => 0 });
 186
 187 # print/pull/push are independent of each other
 188 $needed = { pull_foo => 0 };
 189 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "print", $needed);
 190 is_deeply($needed, { pull_foo => 0, print_foo => 1 });
 191
 192 $needed = { };
 193 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 194 is_deeply($needed, { pull_foo => 1, print_foo => 1, push_foo => 1,
 195                          pull_bar => 1, print_bar => 1, push_bar => 1});
 196
 197 # push/pull/print are always set for functions
 198 $needed = { pull_foo => 0 };
 199 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 200 is_deeply($needed, { pull_foo => 1, print_foo => 1, push_foo => 1,
 201                          pull_bar => 1, push_bar => 1, print_bar => 1});
 202
 203 # public structs are always needed
 204 $needed = {};
 205 NeededTypedef({ NAME => "bla", DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
 206                           $needed);
 207 is_deeply($needed, { });
 208
 209 $needed = {};
 210 NeededTypedef({ PROPERTIES => { public => 1 }, NAME => "bla",
 211                     DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
 212                           $needed);
 213 is_deeply($needed, { pull_bla => 1, print_bla => 1, push_bla => 1 });
 214
 215 # make sure types for elements are set too
 216 $needed = {};
 217 NeededTypedef({ PROPERTIES => { public => 1 }, NAME => "bla",
 218                     DATA => { TYPE => "STRUCT",
 219                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 220                           $needed);
 221 is_deeply($needed, { pull_bla => 1, print_bla => 1, push_bla => 1,
 222                          pull_bar => 1, print_bar => 1, push_bar => 1});
 223
 224 $needed = {};
 225 NeededTypedef({ PROPERTIES => { gensize => 1}, NAME => "bla",
 226                     DATA => { TYPE => "STRUCT",
 227                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 228                           $needed);
 229 is_deeply($needed, { ndr_size_bla => 1 });
 230
 231 # make sure types for elements are set too
 232 $needed = { pull_bla => 1 };
 233 NeededTypedef({ NAME => "bla",
 234                     DATA => { TYPE => "STRUCT",
 235                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 236                           $needed);
 237 is_deeply($needed, { pull_bla => 1, pull_bar => 1 });
 238
 239 $needed = {};
 240 NeededTypedef({ PROPERTIES => { public => 1},
 241                                 NAME => "bla",
 242                     DATA => { TYPE => "STRUCT",
 243                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "rep" } ] } },
 244                           $needed);
 245 is_deeply($needed, { pull_bla => 1, push_bla => 1, print_bla => 1, print_rep => 1,
 246                          pull_bar => 1, push_bar => 1,
 247                                      ndr_bar_to_rep => 1, ndr_rep_to_bar => 1});
 248