← Back to branch summary

~ubuntu-branches/debian/stretch/arb/stretch

« back to all changes in this revision

Viewing changes to GDEHELP/pp.pl

  • Committer: Package Import Robot
  • Author(s): Andreas Tille
  • Date: 2012-12-11 09:59:08 UTC
  • mfrom: (1.1.5)
  • Revision ID: package-import@ubuntu.com-20121211095908-dfk71u2vzgbu9dr2
Tags: 5.5-1
http://bugs.debian.org/686275
http://bugs.debian.org/692499
* New upstream version (+adapted patches)
* Standards-Version: 3.9.4 (no changes needed)
* debian/po: Add Slovak po-debconf translation (Thanks to
  Slavko <slavko@slavino.sk> for the translation)
  Closes: #686275
* debian/rules: Add '-lm' as suggested in patch by Konstantinos Margaritis
  <konstantinos.margaritis@freevec.org> to fix the build problem on armhf.
  This together with new upstream closes: #692499

Show diffs side-by-side

added added

removed removed

Lines of Context:
GDEHELP/pp.pl
 
1
#!/usr/bin/perl
 
2
# ============================================================ #
 
3
#                                                              #
 
4
#   File      : pp.pl                                          #
 
5
#   Purpose   : a simple pseudo-C-preprocessor                 #
 
6
#   Motivation:                                                #
 
7
#     The C-preprocessor behaves different on different        #
 
8
#     systems (e.g. clang, suse) for ARB_GDEmenus.             #
 
9
#     That resulted in various failures,                       #
 
10
#     some detected at compile-time, others at run-time.       #
 
11
#                                                              #
 
12
#   Coded by Ralf Westram (coder@reallysoft.de) in June 2012   #
 
13
#   Institute of Microbiology (Technical University Munich)    #
 
14
#   http://www.arb-home.de/                                    #
 
15
#                                                              #
 
16
# ============================================================ #
 
17
 
 
18
# Restrictions:
 
19
# - '#if' unsupported
 
20
# - comment parsing is error-prone
 
21
 
 
22
use strict;
 
23
use warnings;
 
24
 
 
25
sub parseOneParam(\$) {
 
26
  my ($code_r) = @_;
 
27
 
 
28
  my $inside = '';
 
29
  my @instack = ();
 
30
 
 
31
  my $param = '';
 
32
 
 
33
  while ($$code_r =~ /[()[\],\"\']/o) {
 
34
    my ($before,$sep,$after) = ($`,$&,$');
 
35
 
 
36
    if ($before =~ /\\$/o) { goto SHIFT; }
 
37
    if ($inside eq '"' or $inside eq '\'') {
 
38
      if ($sep eq $inside) { goto POP; }
 
39
      goto SHIFT;
 
40
    }
 
41
    if ($sep eq ',') {
 
42
      $$code_r = $after;
 
43
      return $param.$before;
 
44
    }
 
45
    if ($sep eq '\'' or $sep eq '"' or $sep eq '(' or $sep eq '[') {
 
46
      push @instack, $inside;
 
47
      $inside = $sep;
 
48
      goto SHIFT;
 
49
    }
 
50
    if ($sep eq ')') {
 
51
      if ($inside eq '') {
 
52
        $$code_r = $sep.$after;
 
53
        return $param.$before;
 
54
      }
 
55
      if ($inside ne '(') { die "Misplaced ')' in '$$code_r'\n"; }
 
56
      goto POP;
 
57
    }
 
58
    if ($sep eq ']') {
 
59
      if ($inside ne '[') { die "Misplaced ']' in '$$code_r'\n"; }
 
60
    POP:
 
61
      $inside = pop @instack;
 
62
    SHIFT:
 
63
      $param .= $before.$sep;
 
64
      $$code_r = $after;
 
65
    }
 
66
    else {
 
67
      die "unhandled separator: param='$param'\nbefore='$before'\nsep='$sep'\nafter='$after'\ncode_r='$$code_r'";
 
68
    }
 
69
  }
 
70
 
 
71
  $param .= $$code_r;
 
72
  $$code_r = '';
 
73
 
 
74
  return $param;
 
75
}
 
76
 
 
77
sub parseMacroParams($\@) {
 
78
  my ($code,$param_r) = @_;
 
79
 
 
80
  if (not $code =~ /^\(/o) { die "Expected '(', seen '$code'"; }
 
81
  $code = $';
 
82
 
 
83
 PARAM: while (1) {
 
84
    $code =~ s/^\s+//o;
 
85
    if ($code =~ /^\)/o) { $code = $'; last PARAM; }
 
86
    if ($code eq '') { die "Missing or misplaced ')'"; }
 
87
 
 
88
    my $param = parseOneParam($code);
 
89
    push @$param_r, $param;
 
90
  }
 
91
  return $code;
 
92
}
 
93
 
 
94
sub apply_define($\@);
 
95
sub apply_define($\@) {
 
96
  my ($line,$defr) = @_;
 
97
 
 
98
  my $name = $$defr[0];
 
99
  if ($line =~ /\b$name\b/) {
 
100
    my ($prefix,$suffix) = ($`,$');
 
101
    my $pcount = $$defr[1];
 
102
    if ($pcount==0) {
 
103
      return $prefix.$$defr[2].apply_define($suffix,@$defr);
 
104
    }
 
105
 
 
106
    my @param = ();
 
107
    $suffix = parseMacroParams($suffix,@param);
 
108
 
 
109
    my $paramCount = scalar(@param);
 
110
    if ($paramCount ne $pcount) {
 
111
      die "Expected $pcount arguments for macro '$name' (found $paramCount)\n";
 
112
    }
 
113
 
 
114
    my $expanded = $$defr[$pcount+2];
 
115
    for (my $p=0; $p<$pcount; $p++) {
 
116
      my $search = $$defr[$p+2];
 
117
      my $replace = $param[$p];
 
118
      $expanded =~ s#$search#$replace#g;
 
119
    }
 
120
 
 
121
    return $prefix.$expanded.apply_define($suffix,@$defr);
 
122
  }
 
123
  return $line;
 
124
}
 
125
 
 
126
my @define = (); # list of defines (applied in order). contains array refs to [ name, pcount, [ pnames...,] content ]
 
127
my %define = (); # known defines
 
128
 
 
129
sub apply_defines($) {
 
130
  my ($line) = @_;
 
131
  foreach my $defr (@define) {
 
132
    $line = apply_define($line, @$defr);
 
133
  }
 
134
  return $line;
 
135
}
 
136
 
 
137
sub def_define {
 
138
  my @def = @_;
 
139
  unshift @define, \@def;
 
140
  $define{$def[0]} = 1;
 
141
}
 
142
 
 
143
sub add_define($) {
 
144
  my ($rest) = @_;
 
145
 
 
146
  if ($rest =~ /^[A-Z0-9_]+/io) {
 
147
    my ($name,$param) = ($&,$');
 
148
    if ($param eq '') {
 
149
      def_define($name, 0, '');
 
150
    }
 
151
    elsif ($param =~ /^\s+/o) {
 
152
      def_define($name, 0, apply_defines($'));
 
153
    }
 
154
    elsif ($param =~ /^\(([a-z0-9,_]+)\)\s+/io) {
 
155
      my ($args,$def) = ($1,$');
 
156
      $args =~ s/\s+//oig;
 
157
      my @args = split /,/,$args;
 
158
      my $count = scalar(@args);
 
159
 
 
160
      my @array = ( $name, $count );
 
161
      foreach (@args) { push @array, $_; }
 
162
      push @array, apply_defines($def);
 
163
      def_define(@array);
 
164
    }
 
165
    else {
 
166
      die "invalid macro parameter '$param'";
 
167
    }
 
168
  }
 
169
  else {
 
170
    die "invalid define '$rest'\n";
 
171
  }
 
172
  
 
173
}
 
174
sub rm_define($) {
 
175
  my ($rest) = @_;
 
176
  if ($rest =~ /^[A-Z0-9_]+/io) {
 
177
    my $name = $&;
 
178
    if (exists $define{$name}) {
 
179
      @define = map {
 
180
        my $def_r = $_;
 
181
        if ($$def_r[0] eq $name) { ; }
 
182
        else { $def_r; }
 
183
      } @define;
 
184
      delete $define{$name};
 
185
    }
 
186
    else {
 
187
      die "'$name' has not been defined";
 
188
    }
 
189
  }
 
190
  else {
 
191
    die "invalid undef '$rest'\n";
 
192
  }
 
193
}
 
194
sub is_defined($) {
 
195
  my ($rest) = @_;
 
196
  if ($rest =~ /^[A-Z0-9_]+/io) {
 
197
    my $name = $&;
 
198
    exists $define{$name};
 
199
  }
 
200
  else {
 
201
    die "invalid ifdef '$rest'\n";
 
202
  }
 
203
}
 
204
 
 
205
my $inMultiLineComment = 0;
 
206
 
 
207
sub remove_comments($);
 
208
sub remove_comments($) {
 
209
  my ($line) = @_;
 
210
  if ($inMultiLineComment) {
 
211
    if ($line =~ /\*\//o) {
 
212
      $inMultiLineComment--;
 
213
      $line = $';
 
214
    }
 
215
    if ($inMultiLineComment) {
 
216
      return '';
 
217
    }
 
218
  }
 
219
  if ($line =~ /^[^'"]*\/\//o) {
 
220
    return $`."\n";
 
221
  }
 
222
  if ($line =~ /\/\*/o) {
 
223
    $inMultiLineComment++;
 
224
    return remove_comments($');
 
225
  }
 
226
  return $line;
 
227
}
 
228
 
 
229
sub preprocess($);
 
230
 
 
231
my @include = (); # list of include directories
 
232
 
 
233
sub include_via_ipath($) {
 
234
  my ($name) = @_;
 
235
  foreach (@include) {
 
236
    my $rel = $_.'/'.$name;
 
237
    if (-f $rel) {
 
238
      preprocess($rel);
 
239
      return;
 
240
    }
 
241
  }
 
242
  die "Could not find include file '$name'\n";
 
243
}
 
244
 
 
245
sub include($) {
 
246
  my ($spec) = @_;
 
247
  if ($spec =~ /^\"([^\"]+)\"/o) {
 
248
    my $name = $1;
 
249
    if (-f $name) { preprocess($name); }
 
250
    else { include_via_ipath($name); }
 
251
  }
 
252
  elsif ($spec =~ /^<([^>]+)>/o) {
 
253
    my $name = $1;
 
254
    include_via_ipath($name);
 
255
  }
 
256
  else { die "no idea how to include '$spec'\n"; }
 
257
}
 
258
 
 
259
sub preprocess($) {
 
260
  my ($src) = @_;
 
261
 
 
262
  my $skip = 0;
 
263
  my @skipstack = ();
 
264
 
 
265
  open(my $IN,'<'.$src) || die "can't read '$src' (Reason: $!)";
 
266
  my $line;
 
267
  while (defined($line=<$IN>)) {
 
268
    while ($line =~ /\\\n/o) { # concat multilines
 
269
      my ($body) = $`;
 
270
      my $nextLine = <$IN>;
 
271
      if (not defined $nextLine) { die "runaway multiline"; }
 
272
      $line = $body.$nextLine;
 
273
    }
 
274
 
 
275
    eval {
 
276
      if ($line =~ /^\s*[#]\s*([^\s]*)\s+/o) {
 
277
        my ($token,$rest) = ($1,$');
 
278
        chomp($rest);
 
279
        if ($token eq 'define') { add_define($rest); }
 
280
        elsif ($token eq 'undef') { rm_define($rest); }
 
281
        elsif ($token eq 'include') {
 
282
          my $oline = $.;
 
283
          eval { include($rest); };
 
284
          $. = $oline;
 
285
          if ($@) { die "included from here\n$@"; }
 
286
        }
 
287
        elsif ($token eq 'ifdef') {
 
288
          push @skipstack, $skip;
 
289
          $skip = is_defined($rest) ? 0 : 1;
 
290
        }
 
291
        elsif ($token eq 'else') {
 
292
          if (scalar(@skipstack)==0) { die "else w/o if\n"; }
 
293
          $skip = 1-$skip;
 
294
        }
 
295
        elsif ($token eq 'endif') {
 
296
          if (scalar(@skipstack)==0) { die "endif w/o if\n"; }
 
297
          $skip = pop @skipstack;
 
298
        }
 
299
        else { die "unknown preprocessor token='$token' rest='$rest'\n"; }
 
300
      }
 
301
      else {
 
302
        if ($skip==0) {
 
303
          $line = remove_comments($line);
 
304
          print apply_defines($line);
 
305
        }
 
306
      }
 
307
    };
 
308
    if ($@) { die "$src:$.: $@\n"; }
 
309
  }
 
310
  if (scalar(@skipstack)!=0) { die "EOF reached while inside if\n"; }
 
311
  close($IN);
 
312
}
 
313
 
 
314
sub addIncludePaths($) {
 
315
  my ($pathlist) = @_;
 
316
  my @paths = split /;/, $pathlist;
 
317
  foreach (@paths) { push @include, $_; }
 
318
}
 
319
 
 
320
sub main() {
 
321
  eval {
 
322
    my $src = undef;
 
323
    foreach (@ARGV) {
 
324
      if ($_ =~ /^-I/) {
 
325
        addIncludePaths($');
 
326
      }
 
327
      else {
 
328
        if (defined $src) { die "Multiple sources specified ('$src' and '$_')\n"; }
 
329
        $src = $_;
 
330
      }
 
331
    }
 
332
 
 
333
    preprocess($src);
 
334
  };
 
335
  if ($@) { die "$@ (in pp.pl)\n"; }
 
336
}
 
337
main();
 
338
 
 
339