pidl: Introduce new dirrective: relative_short
[ira/wip.git] / 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 qw(warning);
9 use Parse::Pidl::Util qw(has_property);
10 use strict;
11
12 use vars qw($VERSION);
13 $VERSION = '0.01';
14
15 my %supported_properties = (
16         # interface
17         "helpstring"            => ["INTERFACE", "FUNCTION"],
18         "version"               => ["INTERFACE"],
19         "uuid"                  => ["INTERFACE"],
20         "endpoint"              => ["INTERFACE"],
21         "pointer_default"       => ["INTERFACE"],
22
23         # dcom
24         "object"                => ["INTERFACE"],
25         "local"                 => ["INTERFACE", "FUNCTION"],
26         "iid_is"                => ["ELEMENT"],
27         "call_as"               => ["FUNCTION"],
28         "idempotent"            => ["FUNCTION"],
29
30         # function
31         "in"                    => ["ELEMENT"],
32         "out"                   => ["ELEMENT"],
33
34         # pointer
35         "ref"                   => ["ELEMENT"],
36         "ptr"                   => ["ELEMENT"],
37         "unique"                => ["ELEMENT"],
38         "ignore"                => ["ELEMENT"],
39
40         "value"                 => ["ELEMENT"],
41
42         # generic
43         "public"                => ["FUNCTION", "TYPEDEF"],
44         "nopush"                => ["FUNCTION", "TYPEDEF"],
45         "nopull"                => ["FUNCTION", "TYPEDEF"],
46         "noprint"               => ["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 CheckTypedef($)
78 {
79         my ($td) = @_;
80
81         if (has_property($td, "nodiscriminant")) {
82                 warning($td, "nodiscriminant property not supported");
83         }
84
85         if ($td->{TYPE} eq "BITMAP") {
86                 warning($td, "converting bitmap to scalar");
87                 #FIXME
88         }
89
90         if (has_property($td, "gensize")) {
91                 warning($td, "ignoring gensize() property. ");
92         }
93
94         if (has_property($td, "enum8bit") and has_property($td, "enum16bit")) {
95                 warning($td, "8 and 16 bit enums not supported, converting to scalar");
96                 #FIXME
97         }
98
99         StripProperties($td);
100 }
101
102 sub CheckElement($)
103 {
104         my $e = shift;
105
106         if (has_property($e, "noheader")) {
107                 warning($e, "noheader property not supported");
108                 return;
109         }
110
111         if (has_property($e, "subcontext")) {
112                 warning($e, "converting subcontext to byte array");
113                 #FIXME
114         }
115
116         if (has_property($e, "compression")) {
117                 warning($e, "compression() property not supported");
118         }
119
120         if (has_property($e, "sptr")) {
121                 warning($e, "sptr() pointer property not supported");
122         }
123
124         if (has_property($e, "relative")) {
125                 warning($e, "relative() pointer property not supported");
126         }
127
128         if (has_property($e, "relative_short")) {
129                 warning($e, "relative_short() pointer property not supported");
130         }
131
132         if (has_property($e, "flag")) {
133                 warning($e, "ignoring flag() property");
134         }
135         
136         if (has_property($e, "value")) {
137                 warning($e, "ignoring value() property");
138         }
139 }
140
141 sub CheckFunction($)
142 {
143         my $fn = shift;
144
145         if (has_property($fn, "noopnum")) {
146                 warning($fn, "noopnum not converted. Opcodes will be out of sync.");
147         }
148 }
149
150 sub CheckInterface($)
151 {
152         my $if = shift;
153
154 }
155
156 sub Check($)
157 {
158         my $pidl = shift;
159         my $nidl = [];
160
161         foreach (@{$pidl}) {
162                 push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE");
163         }
164 }
165
166 1;