r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / pidl / lib / Parse / Pidl / Compat.pm
1 ###################################################
2 # IDL Compatibility checker
3 # Copyright jelmer@samba.org 2005
4 # released under the GNU GPL
5
6 package Parse::Pidl::Compat;
7
8 use Parse::Pidl::Util qw(has_property);
9 use strict;
10
11 use vars qw($VERSION);
12 $VERSION = '0.01';
13
14 my %supported_properties = (
15         # interface
16         "helpstring"            => ["INTERFACE", "FUNCTION"],
17         "version"               => ["INTERFACE"],
18         "uuid"                  => ["INTERFACE"],
19         "endpoint"              => ["INTERFACE"],
20         "pointer_default"       => ["INTERFACE"],
21
22         # dcom
23         "object"                => ["INTERFACE"],
24         "local"                 => ["INTERFACE", "FUNCTION"],
25         "iid_is"                => ["ELEMENT"],
26         "call_as"               => ["FUNCTION"],
27         "idempotent"            => ["FUNCTION"],
28
29         # function
30         "in"                    => ["ELEMENT"],
31         "out"                   => ["ELEMENT"],
32
33         # pointer
34         "ref"                   => ["ELEMENT"],
35         "ptr"                   => ["ELEMENT"],
36         "unique"                => ["ELEMENT"],
37         "ignore"                => ["ELEMENT"],
38
39         "value"                 => ["ELEMENT"],
40
41         # generic
42         "public"                => ["FUNCTION", "TYPEDEF"],
43         "nopush"                => ["FUNCTION", "TYPEDEF"],
44         "nopull"                => ["FUNCTION", "TYPEDEF"],
45         "noprint"               => ["FUNCTION", "TYPEDEF"],
46         "noejs"                 => ["FUNCTION", "TYPEDEF"],
47
48         # union
49         "switch_is"             => ["ELEMENT"],
50         "switch_type"           => ["ELEMENT", "TYPEDEF"],
51         "case"                  => ["ELEMENT"],
52         "default"               => ["ELEMENT"],
53
54         # subcontext
55         "subcontext"            => ["ELEMENT"],
56         "subcontext_size"       => ["ELEMENT"],
57
58         # enum
59         "enum16bit"             => ["TYPEDEF"],
60         "v1_enum"               => ["TYPEDEF"],
61
62         # bitmap
63         "bitmap8bit"            => ["TYPEDEF"],
64         "bitmap16bit"           => ["TYPEDEF"],
65         "bitmap32bit"           => ["TYPEDEF"],
66         "bitmap64bit"           => ["TYPEDEF"],
67
68         # array
69         "range"                 => ["ELEMENT"],
70         "size_is"               => ["ELEMENT"],
71         "string"                => ["ELEMENT"],
72         "noheader"              => ["ELEMENT"],
73         "charset"               => ["ELEMENT"],
74         "length_is"             => ["ELEMENT"],
75 );
76
77 sub warning($$)
78 {
79         my ($l,$m) = @_;
80
81         print STDERR "$l->{FILE}:$l->{LINE}:warning:$m\n";
82 }
83
84 sub CheckTypedef($)
85 {
86         my ($td) = @_;
87
88         if (has_property($td, "nodiscriminant")) {
89                 warning($td, "nodiscriminant property not supported");
90         }
91
92         if ($td->{TYPE} eq "BITMAP") {
93                 warning($td, "converting bitmap to scalar");
94                 #FIXME
95         }
96
97         if (has_property($td, "gensize")) {
98                 warning($td, "ignoring gensize() property. ");
99         }
100
101         if (has_property($td, "enum8bit") and has_property($td, "enum16bit")) {
102                 warning($td, "8 and 16 bit enums not supported, converting to scalar");
103                 #FIXME
104         }
105
106         StripProperties($td);
107 }
108
109 sub CheckElement($)
110 {
111         my $e = shift;
112
113         if (has_property($e, "noheader")) {
114                 warning($e, "noheader property not supported");
115                 return;
116         }
117
118         if (has_property($e, "subcontext")) {
119                 warning($e, "converting subcontext to byte array");
120                 #FIXME
121         }
122
123         if (has_property($e, "compression")) {
124                 warning($e, "compression() property not supported");
125         }
126
127         if (has_property($e, "sptr")) {
128                 warning($e, "sptr() pointer property not supported");
129         }
130
131         if (has_property($e, "relative")) {
132                 warning($e, "relative() pointer property not supported");
133         }
134
135         if (has_property($e, "flag")) {
136                 warning($e, "ignoring flag() property");
137         }
138         
139         if (has_property($e, "value")) {
140                 warning($e, "ignoring value() property");
141         }
142 }
143
144 sub CheckFunction($)
145 {
146         my $fn = shift;
147
148         if (has_property($fn, "noopnum")) {
149                 warning($fn, "noopnum not converted. Opcodes will be out of sync.");
150         }
151 }
152
153 sub CheckInterface($)
154 {
155         my $if = shift;
156
157         if (has_property($if, "pointer_default_top") and 
158                 $if->{PROPERTIES}->{pointer_default_top} ne "ref") {
159                 warning($if, "pointer_default_top() is pidl-specific");
160         }
161
162         foreach my $x (@{$if->{DATA}}) {
163                 if ($x->{TYPE} eq "DECLARE") {
164                         warning($if, "the declare keyword is pidl-specific");
165                         next;
166                 }
167         }
168 }
169
170 sub Check($)
171 {
172         my $pidl = shift;
173         my $nidl = [];
174
175         foreach (@{$pidl}) {
176                 push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE");
177         }
178 }
179
180 1;