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 => 38;
   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 NeededType $res
  15         NeededInterface TypeFunctionName);
  16
  17 my $output;
  18 sub print_fn($) { my $x = shift; $output.=$x; }
  19
  20 # Test case 1: Simple unique pointer dereference
  21
  22 $output = "";
  23 my $fn = check_null_pointer({
  24         PARENT => {
  25                 ELEMENTS => [
  26                         {
  27                                 NAME => "bla",
  28                                 LEVELS => [
  29                                         { TYPE => "POINTER",
  30                                           POINTER_INDEX => 0,
  31                                           POINTER_TYPE => "unique" },
  32                                         { TYPE => "DATA" }
  33                                 ],
  34                         },
  35                 ]
  36         }
  37 }, { bla => "r->in.bla" }, \&print_fn, "return;");
  38
  39
  40 test_warnings("", sub { $fn->("r->in.bla"); });
  41
  42 is($output, "if (r->in.bla == NULL) return;");
  43
  44 # Test case 2: Simple ref pointer dereference
  45
  46 $output = "";
  47 $fn = check_null_pointer({
  48         PARENT => {
  49                 ELEMENTS => [
  50                         {
  51                                 NAME => "bla",
  52                                 LEVELS => [
  53                                         { TYPE => "POINTER",
  54                                           POINTER_INDEX => 0,
  55                                           POINTER_TYPE => "ref" },
  56                                         { TYPE => "DATA" }
  57                                 ],
  58                         },
  59                 ]
  60         }
  61 }, { bla => "r->in.bla" }, \&print_fn, undef);
  62
  63 test_warnings("", sub { $fn->("r->in.bla"); });
  64
  65 is($output, "");
  66
  67 # Test case 3: Illegal dereference
  68
  69 $output = "";
  70 $fn = check_null_pointer({
  71         FILE => "nofile",
  72         LINE => 1,
  73         PARENT => {
  74                 ELEMENTS => [
  75                         {
  76                                 NAME => "bla",
  77                                 LEVELS => [
  78                                         { TYPE => "DATA" }
  79                                 ],
  80                         },
  81                 ]
  82         }
  83 }, { bla => "r->in.bla" }, \&print_fn, undef);
  84
  85 test_warnings("nofile:1: too much dereferences for `bla'\n",
  86                   sub { $fn->("r->in.bla"); });
  87
  88 is($output, "");
  89
  90 # Test case 4: Double pointer dereference
  91
  92 $output = "";
  93 $fn = check_null_pointer({
  94         PARENT => {
  95                 ELEMENTS => [
  96                         {
  97                                 NAME => "bla",
  98                                 LEVELS => [
  99                                         { TYPE => "POINTER",
 100                                           POINTER_INDEX => 0,
 101                                           POINTER_TYPE => "unique" },
 102                                         { TYPE => "POINTER",
 103                                           POINTER_INDEX => 1,
 104                                           POINTER_TYPE => "unique" },
 105                                         { TYPE => "DATA" }
 106                                 ],
 107                         },
 108                 ]
 109         }
 110 }, { bla => "r->in.bla" }, \&print_fn, "return;");
 111
 112 test_warnings("",
 113                   sub { $fn->("*r->in.bla"); });
 114
 115 is($output, "if (*r->in.bla == NULL) return;");
 116
 117 # Test case 5: Unknown variable
 118
 119 $output = "";
 120 $fn = check_null_pointer({
 121         FILE => "nofile",
 122         LINE => 2,
 123         PARENT => {
 124                 ELEMENTS => [
 125                         {
 126                                 NAME => "bla",
 127                                 LEVELS => [
 128                                         { TYPE => "DATA" }
 129                                 ],
 130                         },
 131                 ]
 132         }
 133 }, { }, \&print_fn, "return;");
 134
 135 test_warnings("nofile:2: unknown dereferenced expression `r->in.bla'\n",
 136                   sub { $fn->("r->in.bla"); });
 137
 138 is($output, "if (r->in.bla == NULL) return;");
 139
 140 # Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work
 141 $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
 142 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
 143
 144 $fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
 145 is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
 146
 147 $fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
 148 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
 149
 150 $fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
 151 is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
 152
 153 $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
 154 is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionOutEnv($fn));
 155
 156 $fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
 157 is_deeply({ }, GenerateFunctionInEnv($fn));
 158
 159 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 160 is_deeply({ foo => "r->foo", bar => "r->bar", this => "r" },
 161                 GenerateStructEnv($fn, "r"));
 162
 163 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 164 is_deeply({ foo => "some->complex.variable->foo",
 165                     bar => "some->complex.variable->bar",
 166                         this => "some->complex.variable" },
 167                 GenerateStructEnv($fn, "some->complex.variable"));
 168
 169 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] };
 170
 171 my $env = GenerateStructEnv($fn, "r");
 172 EnvSubstituteValue($env, $fn);
 173 is_deeply($env, { foo => 3, this => "r" });
 174
 175 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 176 $env = GenerateStructEnv($fn, "r");
 177 EnvSubstituteValue($env, $fn);
 178 is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" });
 179
 180 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] };
 181
 182 $env = GenerateStructEnv($fn, "r");
 183 EnvSubstituteValue($env, $fn);
 184 is_deeply($env, { foo => 0, this => "r" });
 185
 186 my $needed = {};
 187 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 188 is_deeply($needed, { ndr_pull_foo => 1 });
 189
 190 # old settings should be kept
 191 $needed = { ndr_pull_foo => 0 };
 192 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 193 is_deeply($needed, { ndr_pull_foo => 0 });
 194
 195 # print/pull/push are independent of each other
 196 $needed = { ndr_pull_foo => 0 };
 197 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "print", $needed);
 198 is_deeply($needed, { ndr_pull_foo => 0, ndr_print_foo => 1 });
 199
 200 $needed = { };
 201 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 202 is_deeply($needed, { ndr_pull_foo => 1, ndr_print_foo => 1, ndr_push_foo => 1,
 203                          ndr_pull_bar => 1, ndr_print_bar => 1, ndr_push_bar => 1});
 204
 205 # push/pull/print are always set for functions
 206 $needed = { ndr_pull_foo => 0 };
 207 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 208 is_deeply($needed, { ndr_pull_foo => 1, ndr_print_foo => 1, ndr_push_foo => 1,
 209                          ndr_pull_bar => 1, ndr_push_bar => 1, ndr_print_bar => 1});
 210
 211 # public structs are always needed
 212 $needed = {};
 213 NeededType({ NAME => "bla", TYPE => "TYPEDEF",
 214                 DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
 215                           $needed, "pull");
 216 is_deeply($needed, { });
 217
 218 $needed = {};
 219 NeededInterface({ TYPES => [ { PROPERTIES => { public => 1 }, NAME => "bla",
 220                                 TYPE => "TYPEDEF",
 221                     DATA => { TYPE => "STRUCT", ELEMENTS => [] } } ] },
 222                           $needed);
 223 is_deeply($needed, { ndr_pull_bla => 1, ndr_push_bla => 1, ndr_print_bla => 1 });
 224
 225 # make sure types for elements are set too
 226 $needed = {};
 227 NeededInterface({ TYPES => [ { PROPERTIES => { public => 1 }, NAME => "bla",
 228                                 TYPE => "TYPEDEF",
 229                     DATA => { TYPE => "STRUCT",
 230                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } } ] },
 231                           $needed);
 232 is_deeply($needed, { ndr_pull_bla => 1, ndr_pull_bar => 1, ndr_push_bla => 1, ndr_push_bar => 1,
 233                                          ndr_print_bla => 1, ndr_print_bar => 1});
 234
 235 $needed = {};
 236 NeededInterface({ TYPES => [ { PROPERTIES => { gensize => 1}, NAME => "bla",
 237                                 TYPE => "TYPEDEF",
 238                     DATA => { TYPE => "STRUCT",
 239                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } } ] },
 240                           $needed);
 241 is_deeply($needed, { ndr_size_bla => 1 });
 242
 243 # make sure types for elements are set too
 244 $needed = { ndr_pull_bla => 1 };
 245 NeededType({ NAME => "bla",
 246                                 TYPE => "TYPEDEF",
 247                     DATA => { TYPE => "STRUCT",
 248                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 249                           $needed, "pull");
 250 is_deeply($needed, { ndr_pull_bla => 1, ndr_pull_bar => 1 });
 251
 252 $needed = {};
 253 NeededInterface({ TYPES => [ { PROPERTIES => { public => 1},
 254                                 NAME => "bla",
 255                                 TYPE => "TYPEDEF",
 256                     DATA => { TYPE => "STRUCT",
 257                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "rep" } ] } } ] }, $needed);
 258 is_deeply($needed, { ndr_pull_bla => 1, ndr_push_bla => 1, ndr_print_bla => 1,
 259                                          ndr_print_rep => 1,
 260                          ndr_pull_bar => 1, ndr_push_bar => 1,
 261                                      ndr_bar_to_rep => 1, ndr_rep_to_bar => 1});
 262
 263 $res = "";
 264 Parse::Pidl::Samba4::NDR::Parser::ParseStructPush({
 265                         NAME => "mystruct",
 266                         TYPE => "STRUCT",
 267                         PROPERTIES => {},
 268                         ALIGN => 4,
 269                         ELEMENTS => [ ]}, "x");
 270 is($res, "if (ndr_flags & NDR_SCALARS) {
 271         NDR_CHECK(ndr_push_align(ndr, 4));
 272 }
 273 if (ndr_flags & NDR_BUFFERS) {
 274 }
 275 ");
 276
 277 $res = "";
 278 my $e = {
 279         NAME => "el1",
 280         TYPE => "mytype",
 281         REPRESENTATION_TYPE => "mytype",
 282         PROPERTIES => {},
 283         LEVELS => [
 284                 { LEVEL_INDEX => 0, TYPE => "DATA", DATA_TYPE => "mytype" }
 285 ] };
 286 Parse::Pidl::Samba4::NDR::Parser::ParseStructPush({
 287                         NAME => "mystruct",
 288                         TYPE => "STRUCT",
 289                         PROPERTIES => {},
 290                         ALIGN => 4,
 291                         SURROUNDING_ELEMENT => $e,
 292                         ELEMENTS => [ $e ]}, "x");
 293 is($res, "if (ndr_flags & NDR_SCALARS) {
 294         NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, ndr_string_array_size(ndr, x->el1)));
 295         NDR_CHECK(ndr_push_align(ndr, 4));
 296         NDR_CHECK(ndr_push_mytype(ndr, NDR_SCALARS, &x->el1));
 297 }
 298 if (ndr_flags & NDR_BUFFERS) {
 299 }
 300 ");
 301
 302 is(TypeFunctionName("ndr_pull", "uint32"), "ndr_pull_uint32");
 303 is(TypeFunctionName("ndr_pull", {TYPE => "ENUM", NAME => "bar"}), "ndr_pull_ENUM_bar");
 304 is(TypeFunctionName("ndr_pull", {TYPE => "TYPEDEF", NAME => "bar", DATA => undef}), "ndr_pull_bar");
 305 is(TypeFunctionName("ndr_push", {TYPE => "STRUCT", NAME => "bar"}), "ndr_push_STRUCT_bar");