added code to the IDL validator to check for common errors with
[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
8 use strict;
9
10 #####################################################################
11 # signal a fatal validation error
12 sub fatal($)
13 {
14         my $s = shift;
15         print "$s\n";
16         die "IDL is not valid\n";
17 }
18
19 sub el_name($)
20 {
21         my $e = shift;
22
23         if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
24                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
25         }
26
27         if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
28                 return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
29         }
30
31         if ($e->{PARENT}) {
32                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
33         }
34         return $e->{NAME};
35 }
36
37 #####################################################################
38 # parse a struct
39 sub ValidElement($)
40 {
41         my $e = shift;
42         if ($e->{POINTERS} && $e->{POINTERS} > 1) {
43                 fatal(el_name($e) . " : pidl cannot handle multiple pointer levels. Use a sub-structure containing a pointer instead\n");
44         }
45
46         if ($e->{POINTERS} && $e->{ARRAY_LEN}) {
47                 fatal(el_name($e) . " : pidl cannot handle pointers to arrays. Use a substructure instead\n");
48         }
49 }
50
51 #####################################################################
52 # parse a struct
53 sub ValidStruct($)
54 {
55         my($struct) = shift;
56
57         foreach my $e (@{$struct->{ELEMENTS}}) {
58                 $e->{PARENT} = $struct;
59                 ValidElement($e);
60         }
61 }
62
63
64 #####################################################################
65 # parse a union
66 sub ValidUnion($)
67 {
68         my($union) = shift;
69         foreach my $e (@{$union->{DATA}}) {
70                 $e->{PARENT} = $union;
71                 ValidElement($e);
72         }
73 }
74
75 #####################################################################
76 # parse a typedef
77 sub ValidTypedef($)
78 {
79         my($typedef) = shift;
80         my $data = $typedef->{DATA};
81
82         $data->{PARENT} = $typedef;
83
84         if (ref($data) eq "HASH") {
85                 if ($data->{TYPE} eq "STRUCT") {
86                         ValidStruct($data);
87                 }
88
89                 if ($data->{TYPE} eq "UNION") {
90                         ValidUnion($data);
91                 }
92         }
93 }
94
95 #####################################################################
96 # parse a function
97 sub ValidFunction($)
98 {
99         my($fn) = shift;
100
101         foreach my $e (@{$fn->{DATA}}) {
102                 $e->{PARENT} = $fn;
103                 if (util::has_property($e, "ref") && !$e->{POINTERS}) {
104                         fatal "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
105                 }
106                 ValidElement($e);
107         }
108 }
109
110 #####################################################################
111 # parse the interface definitions
112 sub ValidInterface($)
113 {
114         my($interface) = shift;
115         my($data) = $interface->{DATA};
116
117         foreach my $d (@{$data}) {
118                 ($d->{TYPE} eq "TYPEDEF") &&
119                     ValidTypedef($d);
120                 ($d->{TYPE} eq "FUNCTION") && 
121                     ValidFunction($d);
122         }
123
124 }
125
126 #####################################################################
127 # parse a parsed IDL into a C header
128 sub Validate($)
129 {
130         my($idl) = shift;
131
132         foreach my $x (@{$idl}) {
133                 ($x->{TYPE} eq "INTERFACE") && 
134                     ValidInterface($x);
135         }
136 }
137
138 1;