r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / pidl / smb_interfaces.yp
1 ########################
2 # Parse::Yapp parser for a C header file that contains only structures 
3 # or unions.  
4
5 # Copyright (C) 2005, Tim Potter <tpot@samba.org> released under the
6 # GNU GPL version 2 or later
7
8 ################
9 # grammar
10
11 %%
12
13 definitions:
14         definition                      { [$_[1]] }
15         | definitions definition        { push(@{$_[1]}, $_[2]); $_[1] }
16 ;
17
18 definition:
19         struct 
20         | union 
21         | typedef 
22         | enum
23 ;
24
25 struct: STRUCT optional_identifier '{' elements '}' pointers optional_identifiers ';'
26         {
27                 {
28                         "NAME" => $_[7],
29                         "STRUCT_NAME" => $_[2],
30                         "TYPE" => "struct",
31                         "DATA" => $_[4],
32                 }
33         }
34 ;
35
36 union:
37         UNION optional_identifier '{' elements '}' pointers optional_identifier ';'
38         {
39                 {
40                         "NAME" => $_[7],
41                         "UNION_NAME" => $_[2],
42                         "TYPE" => "union",
43                         "DATA" => $_[4],
44                 }
45         }
46 ;
47
48 typedef:
49         TYPEDEF STRUCT '{' elements '}' optional_identifier ';'
50 ;
51
52 enum:
53         ENUM IDENTIFIER '{' enum_identifiers '}' ';'
54 ;
55
56 enum_identifiers: enum_identifier
57         | enum_identifiers ',' enum_identifier
58 ;
59
60 enum_identifier: IDENTIFIER
61         | IDENTIFIER '=' IDENTIFIER
62 ;
63
64 elements: #empty
65         | elements element { push(@{$_[1]}, $_[2]); $_[1] }
66 ;
67
68 element: 
69         | struct
70         | union
71         | STRUCT IDENTIFIER pointers IDENTIFIER ';'
72                 {{
73                         "NAME" => [$_[2]],
74                         "POINTERS" => $_[3],
75                         "TYPE" => "struct $_[2]",
76                 }}
77         | UNION IDENTIFIER pointers IDENTIFIER ';'
78                 {{
79                         "NAME" => $_[2],
80                         "POINTERS" => $_[3],
81                         "TYPE" => "union $_[2]",
82                 }}
83         | CONST type pointers IDENTIFIER array ';'
84                 {{
85                            "NAME" => [$_[4]],
86                            "TYPE" => $_[2],
87                            "POINTERS" => $_[3],
88                 }}
89         | type pointers IDENTIFIER array ';'
90                 {{
91                            "NAME" => [$_[3]],
92                            "TYPE" => $_[1],
93                            "POINTERS" => $_[2],
94                            "ARRAY_LENGTH" => $_[4]
95                 }}
96 ;
97
98 array: #empty
99         | '[' CONSTANT  ']'     { int($_[2]) }
100 ;
101
102 type: IDENTIFIER
103         | ENUM IDENTIFIER
104                 { "enum $_[2]" }
105 ;
106
107 pointers: 
108    #empty { 0 }
109    | pointers '*'  { $_[1]+1 }
110 ;
111
112 optional_identifiers: optional_identifier { [$_[1]] }
113         | optional_identifiers ',' optional_identifier { push(@{$_[1]}, $_[3]); $_[1] }
114 ;
115
116 optional_identifier: IDENTIFIER | #empty { undef }
117 ;
118
119 %%
120
121 #####################################################################
122 # traverse a perl data structure removing any empty arrays or
123 # hashes and any hash elements that map to undef
124 sub CleanData($)
125 {
126     sub CleanData($);
127     my($v) = shift;
128     if (ref($v) eq "ARRAY") {
129         foreach my $i (0 .. $#{$v}) {
130             CleanData($v->[$i]);
131             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
132                     $v->[$i] = undef; 
133                     next; 
134             }
135         }
136         # this removes any undefined elements from the array
137         @{$v} = grep { defined $_ } @{$v};
138     } elsif (ref($v) eq "HASH") {
139         foreach my $x (keys %{$v}) {
140             CleanData($v->{$x});
141             if (!defined $v->{$x}) { delete($v->{$x}); next; }
142             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
143         }
144     }
145         return $v;
146 }
147
148 sub _Error {
149     if (exists $_[0]->YYData->{ERRMSG}) {
150                 print $_[0]->YYData->{ERRMSG};
151                 delete $_[0]->YYData->{ERRMSG};
152                 return;
153         };
154         my $line = $_[0]->YYData->{LINE};
155         my $last_token = $_[0]->YYData->{LAST_TOKEN};
156         my $file = $_[0]->YYData->{INPUT_FILENAME};
157         
158         print "$file:$line: Syntax error near '$last_token'\n";
159 }
160
161 sub _Lexer($)
162 {
163         my($parser)=shift;
164
165     $parser->YYData->{INPUT} or return('',undef);
166
167 again:
168         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
169
170         for ($parser->YYData->{INPUT}) {
171                 if (/^\#/) {
172                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
173                                 $parser->YYData->{LINE} = $1-1;
174                                 $parser->YYData->{INPUT_FILENAME} = $2;
175                                 goto again;
176                         }
177                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
178                                 $parser->YYData->{LINE} = $1-1;
179                                 $parser->YYData->{INPUT_FILENAME} = $2;
180                                 goto again;
181                         }
182                         if (s/^(\#.*)$//m) {
183                                 goto again;
184                         }
185                 }
186                 if (s/^(\n)//) {
187                         $parser->YYData->{LINE}++;
188                         goto again;
189                 }
190                 if (s/^\"(.*?)\"//) {
191                         $parser->YYData->{LAST_TOKEN} = $1;
192                         return('TEXT',$1); 
193                 }
194                 if (s/^(\d+)(\W|$)/$2/) {
195                         $parser->YYData->{LAST_TOKEN} = $1;
196                         return('CONSTANT',$1); 
197                 }
198                 if (s/^([\w_]+)//) {
199                         $parser->YYData->{LAST_TOKEN} = $1;
200                         if ($1 =~ 
201                             /^(const|typedef|union|struct|enum)$/x) {
202                                 return uc($1);
203                         }
204                         return('IDENTIFIER',$1);
205                 }
206                 if (s/^(.)//s) {
207                         $parser->YYData->{LAST_TOKEN} = $1;
208                         return($1,$1);
209                 }
210         }
211 }
212
213 sub parse($$)
214 {
215         my ($self,$filename) = @_;
216
217         my $saved_delim = $/;
218         undef $/;
219         my $cpp = $ENV{CPP};
220         if (! defined $cpp) {
221                 $cpp = "cpp"
222         }
223         my $data = `$cpp -D__PIDL__ -xc $filename`;
224         $/ = $saved_delim;
225
226     $self->YYData->{INPUT} = $data;
227     $self->YYData->{LINE} = 0;
228     $self->YYData->{LAST_TOKEN} = "NONE";
229
230         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
231
232         return CleanData($idl);
233 }