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 => 34;
   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
  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" },
 160                 GenerateStructEnv($fn, "r"));
 161
 162 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 163 is_deeply({ foo => "some->complex.variable->foo",
 164                     bar => "some->complex.variable->bar",
 165                         this => "some->complex.variable" },
 166                 GenerateStructEnv($fn, "some->complex.variable"));
 167
 168 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] };
 169
 170 my $env = GenerateStructEnv($fn, "r");
 171 EnvSubstituteValue($env, $fn);
 172 is_deeply($env, { foo => 3, this => "r" });
 173
 174 $fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
 175 $env = GenerateStructEnv($fn, "r");
 176 EnvSubstituteValue($env, $fn);
 177 is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" });
 178
 179 $fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] };
 180
 181 $env = GenerateStructEnv($fn, "r");
 182 EnvSubstituteValue($env, $fn);
 183 is_deeply($env, { foo => 0, this => "r" });
 184
 185 my $needed = {};
 186 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 187 is_deeply($needed, { pull_foo => 1 });
 188
 189 # old settings should be kept
 190 $needed = { pull_foo => 0 };
 191 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed);
 192 is_deeply($needed, { pull_foo => 0 });
 193
 194 # print/pull/push are independent of each other
 195 $needed = { pull_foo => 0 };
 196 NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "print", $needed);
 197 is_deeply($needed, { pull_foo => 0, print_foo => 1 });
 198
 199 $needed = { };
 200 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 201 is_deeply($needed, { pull_foo => 1, print_foo => 1, push_foo => 1,
 202                          pull_bar => 1, print_bar => 1, push_bar => 1});
 203
 204 # push/pull/print are always set for functions
 205 $needed = { pull_foo => 0 };
 206 NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed);
 207 is_deeply($needed, { pull_foo => 1, print_foo => 1, push_foo => 1,
 208                          pull_bar => 1, push_bar => 1, print_bar => 1});
 209
 210 # public structs are always needed
 211 $needed = {};
 212 NeededType({ NAME => "bla", DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
 213                           $needed);
 214 is_deeply($needed, { });
 215
 216 $needed = {};
 217 NeededType({ PROPERTIES => { public => 1 }, NAME => "bla",
 218                     DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
 219                           $needed);
 220 is_deeply($needed, { pull_bla => 1, print_bla => 1, push_bla => 1 });
 221
 222 # make sure types for elements are set too
 223 $needed = {};
 224 NeededType({ PROPERTIES => { public => 1 }, NAME => "bla",
 225                     DATA => { TYPE => "STRUCT",
 226                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 227                           $needed);
 228 is_deeply($needed, { pull_bla => 1, print_bla => 1, push_bla => 1,
 229                          pull_bar => 1, print_bar => 1, push_bar => 1});
 230
 231 $needed = {};
 232 NeededType({ PROPERTIES => { gensize => 1}, NAME => "bla",
 233                     DATA => { TYPE => "STRUCT",
 234                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 235                           $needed);
 236 is_deeply($needed, { ndr_size_bla => 1 });
 237
 238 # make sure types for elements are set too
 239 $needed = { pull_bla => 1 };
 240 NeededType({ NAME => "bla",
 241                     DATA => { TYPE => "STRUCT",
 242                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
 243                           $needed);
 244 is_deeply($needed, { pull_bla => 1, pull_bar => 1 });
 245
 246 $needed = {};
 247 NeededType({ PROPERTIES => { public => 1},
 248                                 NAME => "bla",
 249                     DATA => { TYPE => "STRUCT",
 250                                                   ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "rep" } ] } },
 251                           $needed);
 252 is_deeply($needed, { pull_bla => 1, push_bla => 1, print_bla => 1, print_rep => 1,
 253                          pull_bar => 1, push_bar => 1,
 254                                      ndr_bar_to_rep => 1, ndr_rep_to_bar => 1});
 255
 256 $res = "";
 257 Parse::Pidl::Samba4::NDR::Parser::ParseStructPush({
 258                         NAME => "mystruct",
 259                         TYPE => "STRUCT",
 260                         PROPERTIES => {},
 261                         ALIGN => 4,
 262                         ELEMENTS => [ ]}, "x");
 263 is($res, "if (ndr_flags & NDR_SCALARS) {
 264         NDR_CHECK(ndr_push_align(ndr, 4));
 265 }
 266 if (ndr_flags & NDR_BUFFERS) {
 267 }
 268 ");
 269
 270 $res = "";
 271 my $e = {
 272         NAME => "el1",
 273         TYPE => "mytype",
 274         REPRESENTATION_TYPE => "mytype",
 275         PROPERTIES => {},
 276         LEVELS => [
 277                 { LEVEL_INDEX => 0, TYPE => "DATA", DATA_TYPE => "mytype" }
 278 ] };
 279 Parse::Pidl::Samba4::NDR::Parser::ParseStructPush({
 280                         NAME => "mystruct",
 281                         TYPE => "STRUCT",
 282                         PROPERTIES => {},
 283                         ALIGN => 4,
 284                         SURROUNDING_ELEMENT => $e,
 285                         ELEMENTS => [ $e ]}, "x");
 286 is($res, "if (ndr_flags & NDR_SCALARS) {
 287         NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, ndr_string_array_size(ndr, x->el1)));
 288         NDR_CHECK(ndr_push_align(ndr, 4));
 289         NDR_CHECK(ndr_push_mytype(ndr, NDR_SCALARS, &x->el1));
 290 }
 291 if (ndr_flags & NDR_BUFFERS) {
 292 }
 293 ");