r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / pidl / lib / Parse / Pidl / Typelist.pm
1 ###################################################
2 # Samba4 parser generator for IDL structures
3 # Copyright jelmer@samba.org 2005
4 # released under the GNU GPL
5
6 package Parse::Pidl::Typelist;
7
8 require Exporter;
9 @ISA = qw(Exporter);
10 @EXPORT_OK = qw(hasType getType mapType);
11 use vars qw($VERSION);
12 $VERSION = '0.01';
13
14 use Parse::Pidl::Util qw(has_property);
15 use strict;
16
17 my %typedefs = ();
18
19 # a list of known scalar types
20 my $scalars = {
21         # 0 byte types
22         "void"          => {
23                                 C_TYPE          => "void",
24                                 IS_REFERENCE    => 0,
25                         },
26
27         # 1 byte types
28         "char"          => {
29                                 C_TYPE          => "char",
30                                 IS_REFERENCE    => 0,
31                         },
32         "int8"          => {
33                                 C_TYPE          => "int8_t",
34                                 IS_REFERENCE    => 0,
35                         },
36         "uint8"         => {
37                                 C_TYPE          => "uint8_t",
38                                 IS_REFERENCE    => 0,
39                         },
40
41         # 2 byte types
42         "int16"         => {
43                                 C_TYPE          => "int16_t",
44                                 IS_REFERENCE    => 0,
45                         },
46         "uint16"        => {    C_TYPE          => "uint16_t",
47                                 IS_REFERENCE    => 0,
48                         },
49
50         # 4 byte types
51         "int32"         => {
52                                 C_TYPE          => "int32_t",
53                                 IS_REFERENCE    => 0,
54                         },
55         "uint32"        => {    C_TYPE          => "uint32_t",
56                                 IS_REFERENCE    => 0,
57                         },
58
59         # 8 byte types
60         "hyper"         => {
61                                 C_TYPE          => "uint64_t",
62                                 IS_REFERENCE    => 0,
63                         },
64         "dlong"         => {
65                                 C_TYPE          => "int64_t",
66                                 IS_REFERENCE    => 0,
67                         },
68         "udlong"        => {
69                                 C_TYPE          => "uint64_t",
70                                 IS_REFERENCE    => 0,
71                         },
72         "udlongr"       => {
73                                 C_TYPE          => "uint64_t",
74                                 IS_REFERENCE    => 0,
75                         },
76         # assume its a 8 byte type, but cope with either
77         "pointer"       => {
78                                 C_TYPE          => "void*",
79                                 IS_REFERENCE    => 0,
80                         },
81
82         # DATA_BLOB types
83         "DATA_BLOB"     => {
84                                 C_TYPE          => "DATA_BLOB",
85                                 IS_REFERENCE    => 0,
86                         },
87
88         # string types
89         "string"        => {
90                                 C_TYPE          => "const char *",
91                                 IS_REFERENCE    => 1,
92                         },
93         "string_array"  => {
94                                 C_TYPE          => "const char **",
95                                 IS_REFERENCE    => 1,
96                         },
97
98         # time types
99         "time_t"        => {
100                                 C_TYPE          => "time_t",
101                                 IS_REFERENCE    => 0,
102                         },
103         "NTTIME"        => {
104                                 C_TYPE          => "NTTIME",
105                                 IS_REFERENCE    => 0,
106                         },
107         "NTTIME_1sec"   => {
108                                 C_TYPE          => "NTTIME",
109                                 IS_REFERENCE    => 0,
110                         },
111         "NTTIME_hyper"  => {
112                                 C_TYPE          => "NTTIME",
113                                 IS_REFERENCE    => 0,
114                         },
115
116
117         # error code types
118         "WERROR"        => {
119                                 C_TYPE          => "WERROR",
120                                 IS_REFERENCE    => 0,
121                         },
122         "NTSTATUS"      => {
123                                 C_TYPE          => "NTSTATUS",
124                                 IS_REFERENCE    => 0,
125                         },
126         "COMRESULT" => { 
127                                 C_TYPE          => "COMRESULT",
128                                 IS_REFERENCE    => 0,
129                         },
130
131         # special types
132         "nbt_string"    => {
133                                 C_TYPE          => "const char *",
134                                 IS_REFERENCE    => 1,
135                         },
136         "wrepl_nbt_name"=> {
137                                 C_TYPE          => "struct nbt_name *",
138                                 IS_REFERENCE    => 1,
139                         },
140         "ipv4address"   => {
141                                 C_TYPE          => "const char *",
142                                 IS_REFERENCE    => 1,
143                         }
144 };
145
146 # map from a IDL type to a C header type
147 sub mapScalarType($)
148 {
149         my $name = shift;
150
151         # it's a bug when a type is not in the list
152         # of known scalars or has no mapping
153         return $typedefs{$name}->{DATA}->{C_TYPE} if defined($typedefs{$name}) and defined($typedefs{$name}->{DATA}->{C_TYPE});
154
155         die("Unknown scalar type $name");
156 }
157
158 sub addType($)
159 {
160         my $t = shift;
161         $typedefs{$t->{NAME}} = $t;
162 }
163
164 sub getType($)
165 {
166         my $t = shift;
167         return undef if not hasType($t);
168         return $typedefs{$t};
169 }
170
171 sub typeIs($$)
172 {
173         my $t = shift;
174         my $tt = shift;
175
176         return 1 if (hasType($t) and getType($t)->{DATA}->{TYPE} eq $tt);
177         return 0;
178 }
179
180 sub hasType($)
181 {
182         my $t = shift;
183         return 1 if defined($typedefs{$t});
184         return 0;
185 }
186
187 sub is_scalar($)
188 {
189         my $type = shift;
190
191         return 0 unless(hasType($type));
192
193         if (my $dt = getType($type)->{DATA}->{TYPE}) {
194                 return 1 if ($dt eq "SCALAR" or $dt eq "ENUM" or $dt eq "BITMAP");
195         }
196
197         return 0;
198 }
199
200 sub scalar_is_reference($)
201 {
202         my $name = shift;
203
204         return $scalars->{$name}{IS_REFERENCE} if defined($scalars->{$name}) and defined($scalars->{$name}{IS_REFERENCE});
205         return 0;
206 }
207
208 sub RegisterScalars()
209 {
210         foreach my $k (keys %{$scalars}) {
211                 $typedefs{$k} = {
212                         NAME => $k,
213                         TYPE => "TYPEDEF",
214                         DATA => $scalars->{$k}
215                 };
216                 $typedefs{$k}->{DATA}->{TYPE} = "SCALAR";
217                 $typedefs{$k}->{DATA}->{NAME} = $k;
218         }
219 }
220
221 my $aliases = {
222         "DWORD" => "uint32",
223         "int" => "int32",
224         "WORD" => "uint16",
225         "char" => "uint8",
226         "long" => "int32",
227         "short" => "int16",
228         "HYPER_T" => "hyper",
229         "HRESULT" => "COMRESULT",
230 };
231
232 sub RegisterAliases()
233 {
234         foreach my $k (keys %{$aliases}) {
235                 $typedefs{$k} = $typedefs{$aliases->{$k}};
236         }
237 }
238
239 sub enum_type_fn($)
240 {
241         my $enum = shift;
242         if (has_property($enum->{PARENT}, "enum8bit")) {
243                 return "uint8";
244         } elsif (has_property($enum->{PARENT}, "v1_enum")) {
245                 return "uint32";
246         }
247         return "uint16";
248 }
249
250 sub bitmap_type_fn($)
251 {
252         my $bitmap = shift;
253
254         if (has_property($bitmap, "bitmap8bit")) {
255                 return "uint8";
256         } elsif (has_property($bitmap, "bitmap16bit")) {
257                 return "uint16";
258         } elsif (has_property($bitmap, "bitmap64bit")) {
259                 return "hyper";
260         }
261         return "uint32";
262 }
263
264 sub mapType($)
265 {
266         my $t = shift;
267         die("Undef passed to mapType") unless defined($t);
268         my $dt;
269
270         unless ($dt or ($dt = getType($t))) {
271                 # Best guess
272                 return "struct $t";
273         }
274         return mapScalarType($t) if ($dt->{DATA}->{TYPE} eq "SCALAR");
275         return "enum $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "ENUM");
276         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "STRUCT");
277         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "INTERFACE");
278         return "union $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "UNION");
279
280         if ($dt->{DATA}->{TYPE} eq "BITMAP") {
281                 return mapScalarType(bitmap_type_fn($dt->{DATA}));
282         }
283
284         die("Unknown type $dt->{DATA}->{TYPE}");
285 }
286
287 sub LoadIdl($)
288 {
289         my $idl = shift;
290
291         foreach my $x (@{$idl}) {
292                 next if $x->{TYPE} ne "INTERFACE";
293
294                 # DCOM interfaces can be types as well
295                 addType({
296                         NAME => $x->{NAME},
297                         TYPE => "TYPEDEF",
298                         DATA => $x
299                         }) if (has_property($x, "object"));
300
301                 foreach my $y (@{$x->{DATA}}) {
302                         addType($y) if (
303                                 $y->{TYPE} eq "TYPEDEF" 
304                              or $y->{TYPE} eq "DECLARE");
305                 }
306         }
307 }
308
309 RegisterScalars();
310 RegisterAliases();
311
312 1;