if Options.options.debug:
conf.ADD_CFLAGS('-g', testflags=True)
+ if Options.options.pidl_developer:
+ conf.env.PIDL_DEVELOPER_MODE = True
+
if Options.options.developer:
conf.env.DEVELOPER_MODE = True
if cpp == "CPP=xlc_r":
cpp = ""
+ if bld.env['PIDL_DEVELOPER_MODE']:
+ pidl_dev = 'PIDL_DEVELOPER=1 '
+ else:
+ pidl_dev = ''
if bld.CONFIG_SET("CC"):
if isinstance(bld.CONFIG_GET("CC"), list):
else:
cc = 'CC="%s"' % bld.CONFIG_GET("CC")
- t = bld(rule='cd ${PIDL_LAUNCH_DIR} && %s %s ${PERL} ${PIDL} --quiet ${OPTIONS} --outputdir ${OUTPUTDIR} -- "${IDLSRC}"' % (cpp, cc),
+ t = bld(rule='cd ${PIDL_LAUNCH_DIR} && %s%s %s ${PERL} ${PIDL} --quiet ${OPTIONS} --outputdir ${OUTPUTDIR} -- "${IDLSRC}"' % (pidl_dev, cpp, cc),
ext_out = '.c',
before = 'c',
update_outputs = True,
gr.add_option('--enable-developer',
help=("Turn on developer warnings and debugging"),
action="store_true", dest='developer', default=False)
+ gr.add_option('--pidl-developer',
+ help=("annotate PIDL-generated code for developers"),
+ action="store_true", dest='pidl_developer', default=False)
gr.add_option('--disable-warnings-as-errors',
help=("Do not treat all warnings as errors (disable -Werror)"),
action="store_true", dest='disable_warnings_as_errors', default=False)
$self->{res} .= "$txt\n";
$self->{res_hdr} .= "$txt\n";
}
+
+
+# When the PIDL_DEVELOPER env flag is set, we overwrite $self->pidl()
+# and $self->pidl_hdr() to annotate the output with location
+# information.
+
+sub pidl_dev_msg {
+ my $self = shift;
+ my ($pkg, $file, $line, $sub) = caller(2);
+ # minimise the path
+ if ($file =~ m{/pidl/(lib/.+|pidl)$}) {
+ $file = $1;
+ }
+ my $state = $self->{dev_state} // ['uninitialised', 0, ''];
+ my ($ploc, $pline, $ptabs) = @$state;
+ my $loc = "$sub $file";
+
+ if ($loc ne $ploc or
+ abs($line - $pline) > 20 or
+ $self->{tabs} ne $ptabs) {
+ $self->{dev_state} = [$loc, $line, $self->{tabs}];
+ return " //<PIDL> $loc:$line";
+ }
+ return '';
+}
+
+
+if ($ENV{PIDL_DEVELOPER}) {
+ undef &pidl;
+ undef &pidl_hdr;
+
+ *Parse::Pidl::Base::pidl = sub {
+ my ($self, $txt) = @_;
+
+ if ($txt) {
+ if ($txt !~ /^#/) {
+ $self->{res} .= $self->{tabs};
+ }
+ $self->{res} .= $txt;
+ }
+ $self->{res} .= $self->pidl_dev_msg;
+ $self->{res} .= "\n";
+ };
+
+ *Parse::Pidl::Base::pidl_hdr = sub {
+ my ($self, $txt) = @_;
+ $txt .= $self->pidl_dev_msg;
+ $self->{res_hdr} .= "$txt\n";
+ }
+}
+
+
+1;