r5465: Add support to multiple levels of pointers in pidl.
[samba.git] / source4 / build / pidl / validator.pm
1 ###################################################
2 # check that a parsed IDL file is valid
3 # Copyright tridge@samba.org 2003
4 # released under the GNU GPL
5
6 package IdlValidator;
7 use Data::Dumper;
8
9 use strict;
10
11 #####################################################################
12 # signal a fatal validation error
13 sub fatal($)
14 {
15         my $s = shift;
16         print "$s\n";
17         die "IDL is not valid\n";
18 }
19
20 sub el_name($)
21 {
22         my $e = shift;
23
24         if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
25                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
26         }
27
28         if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
29                 return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
30         }
31
32         if ($e->{PARENT}) {
33                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
34         }
35         return $e->{NAME};
36 }
37
38 #####################################################################
39 # parse a struct
40 sub ValidElement($)
41 {
42         my $e = shift;
43         if ($e->{POINTERS} && $e->{ARRAY_LEN}) {
44                 fatal(el_name($e) . " : pidl cannot handle pointers to arrays. Use a substructure instead\n");
45         }
46         
47         if (util::has_property($e, "ptr")) {
48                 fatal(el_name($e) . " : pidl does not support full NDR pointers yet\n");
49         }
50         
51         if (!$e->{POINTERS} && (
52                 util::has_property($e, "ptr") or
53                 util::has_property($e, "unique") or
54                 util::has_property($e, "relative") or
55                 util::has_property($e, "ref"))) {
56                 fatal(el_name($e) . " : pointer properties on non-pointer element\n");  
57         }
58 }
59
60 #####################################################################
61 # parse a struct
62 sub ValidStruct($)
63 {
64         my($struct) = shift;
65
66         foreach my $e (@{$struct->{ELEMENTS}}) {
67                 if (util::has_property($e, "ref")) {
68                         fatal(el_name($e) . " : embedded ref pointers are not supported yet\n");
69                 }
70         
71                 $e->{PARENT} = $struct;
72                 ValidElement($e);
73         }
74 }
75
76 #####################################################################
77 # parse a union
78 sub ValidUnion($)
79 {
80         my($union) = shift;
81         foreach my $e (@{$union->{ELEMENTS}}) {
82                 $e->{PARENT} = $union;
83
84                 if (defined($e->{PROPERTIES}->{default}) and 
85                         defined($e->{PROPERTIES}->{case})) {
86                         fatal "Union member $e->{NAME} can not have both default and case properties!\n";
87                 }
88                 
89                 unless (defined ($e->{PROPERTIES}->{default}) or 
90                                 defined ($e->{PROPERTIES}->{case})) {
91                         fatal "Union member $e->{NAME} must have default or case property\n";
92                 }
93
94                 if (util::has_property($e, "ref")) {
95                         fatal(el_name($e) . " : embedded ref pointers are not supported yet\n");
96                 }
97
98
99                 ValidElement($e);
100         }
101 }
102
103 #####################################################################
104 # parse a typedef
105 sub ValidTypedef($)
106 {
107         my($typedef) = shift;
108         my $data = $typedef->{DATA};
109
110         $data->{PARENT} = $typedef;
111
112         if (ref($data) eq "HASH") {
113                 if ($data->{TYPE} eq "STRUCT") {
114                         ValidStruct($data);
115                 }
116
117                 if ($data->{TYPE} eq "UNION") {
118                         ValidUnion($data);
119                 }
120         }
121 }
122
123 #####################################################################
124 # parse a function
125 sub ValidFunction($)
126 {
127         my($fn) = shift;
128
129         foreach my $e (@{$fn->{ELEMENTS}}) {
130                 $e->{PARENT} = $fn;
131                 if (util::has_property($e, "ref") && !$e->{POINTERS}) {
132                         fatal "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
133                 }
134                 ValidElement($e);
135         }
136 }
137
138 #####################################################################
139 # parse the interface definitions
140 sub ValidInterface($)
141 {
142         my($interface) = shift;
143         my($data) = $interface->{DATA};
144
145         if (util::has_property($interface, "pointer_default") && 
146                 $interface->{PROPERTIES}->{pointer_default} eq "ptr") {
147                 fatal "Full pointers are not supported yet\n";
148         }
149
150         if (util::has_property($interface, "object")) {
151         if(util::has_property($interface, "version") && 
152                         $interface->{PROPERTIES}->{version} != 0) {
153                         fatal "Object interfaces must have version 0.0 ($interface->{NAME})\n";
154                 }
155
156                 if(!defined($interface->{BASE}) && 
157                         not ($interface->{NAME} eq "IUnknown")) {
158                         fatal "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
159                 }
160         }
161                 
162         foreach my $d (@{$data}) {
163                 ($d->{TYPE} eq "TYPEDEF") &&
164                     ValidTypedef($d);
165                 ($d->{TYPE} eq "FUNCTION") && 
166                     ValidFunction($d);
167         }
168
169 }
170
171 #####################################################################
172 # parse a parsed IDL into a C header
173 sub Validate($)
174 {
175         my($idl) = shift;
176
177         foreach my $x (@{$idl}) {
178                 ($x->{TYPE} eq "INTERFACE") && 
179                     ValidInterface($x);
180         }
181 }
182
183 1;