summaryrefslogtreecommitdiff
path: root/ACE/bin/rm_exception_macros.pl
diff options
context:
space:
mode:
Diffstat (limited to 'ACE/bin/rm_exception_macros.pl')
-rwxr-xr-xACE/bin/rm_exception_macros.pl292
1 files changed, 292 insertions, 0 deletions
diff --git a/ACE/bin/rm_exception_macros.pl b/ACE/bin/rm_exception_macros.pl
new file mode 100755
index 00000000000..1f671cf154f
--- /dev/null
+++ b/ACE/bin/rm_exception_macros.pl
@@ -0,0 +1,292 @@
+eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
+ & eval 'exec perl -w -S $0 $argv:q'
+ if 0;
+
+# ******************************************************************
+# Author: Chad Elliott
+# Date: 1/24/2007
+# $Id$
+# Description: This script attempts to remove the ACE related exception
+# macros from source code provided on the comand line. It
+# is not perfect, but does handle a large number of cases.
+# You may need to hand edit files after running this
+# script.
+# ******************************************************************
+
+# ******************************************************************
+# Pragma Section
+# ******************************************************************
+
+use strict;
+use FileHandle;
+use File::Basename;
+
+# ******************************************************************
+# Data Section
+# ******************************************************************
+
+my(%macros) = ('ACE_ENV_TYPE' => 'CORBA::Environment',
+ 'ACE_TRY_ENV' => '_ACE_CORBA_Environment_variable',
+ 'ACE_EXCEPTION_TYPE' => 'CORBA::Exception',
+ 'ACE_DEFAULT_GET_ENV_METHOD' => 'TAO_default_environment',
+ 'ACE_DECLARE_NEW_ENV' => '',
+ 'ACE_DECLARE_NEW_CORBA_ENV' => '',
+ 'ACE_CHECK *\(.*\)' => '',
+ 'ACE_CHECK' => '',
+ 'ACE_CHECK_RETURN *\(.*\)' => '',
+ 'ACE_THROW_INT *\((.*)\)' => 'throw $1',
+ 'ACE_THROW *\((.*)\)' => 'throw $1',
+# 'ACE_THROW_RETURN *\((.*),.+\)' => 'throw $1',
+ 'ACE_TRY' => 'try',
+ 'ACE_TRY_NEW_ENV' => 'try',
+ 'ACE_TRY_EX *\([^\)]+\)' => 'try',
+ 'ACE_TRY_CHECK' => '',
+ 'ACE_TRY_CHECK_EX *\([^\)]+\)' => '',
+ 'ACE_TRY_THROW *\((.*)\)' => 'throw $1',
+ 'ACE_TRY_THROW_EX *\((.*),.+\)' => 'throw $1',
+ 'ACE_CATCH *\((.*),(.+)\)' => 'catch (const $1& $2)',
+ 'ACE_CATCHANY' => 'catch (const CORBA::Exception& ex)',
+ 'ACE_CATCHALL' => 'catch (...)',
+ 'ACE_RETHROW' => 'throw',
+ 'ACE_RE_THROW' => 'throw',
+ 'ACE_RE_THROW_EX *\(.+\)' => 'throw',
+ 'ACE_ENDTRY' => '',
+ 'ACE_ENV_RAISE *\((.+)\)' => '$1->_raise ()',
+ 'ACE_PRINT_TAO_EXCEPTION *\(([^,]+),(.+)\)' => '$1._tao_print_exception ($2)',
+ 'ACE_PRINT_EXCEPTION *\(([^,]+),(.+)\)' => '$1._tao_print_exception ($2)',
+ 'TAO_INTERCEPTOR_CHECK_RETURN *\(.*\)' => '',
+ 'TAO_INTERCEPTOR_CHECK' => '',
+ );
+my(@keys) = sort { length($b) <=> length($a) } keys %macros;
+
+# ******************************************************************
+# Subroutine Section
+# ******************************************************************
+
+sub process_file {
+ my($file) = shift;
+ my($fh) = new FileHandle();
+ my($status) = 0;
+
+ if (open($fh, $file)) {
+ my(@lines) = ();
+ my($mod) = undef;
+ my($line) = '';
+ my($cont_until_semicolon) = undef;
+ while(<$fh>) {
+ my($part) = $_;
+ $part =~ s/\s+$//;
+
+ if ($cont_until_semicolon) {
+ if ($part =~ s/^\s+// && $line =~ /[,\)]$/) {
+ $part = ' ' . $part;
+ }
+ $line .= $part;
+ if (index($part, ';') >= 0) {
+ $cont_until_semicolon = undef;
+ }
+ else {
+ next;
+ }
+ }
+ else {
+ $line = $part;
+ }
+
+ my($skip_blank) = undef;
+ foreach my $key (@keys) {
+ my($base) = undef;
+ if ($key =~ /^([^\s]+\s\*\\\()/) {
+ $base = $1;
+ }
+ if ($line =~ /^(\s*)?($key\s*[;]?)/) {
+ my($space) = $1;
+ my($rest) = $2;
+ my($first) = $3 || '';
+ my($second) = $4 || '';
+ my($val) = $macros{$key};
+ while($val =~ /\$(\d+)/) {
+ my($num) = $1;
+ if ($num == 1) {
+ $first =~ s/^\s+//;
+ $first =~ s/\s+$//;
+ $val =~ s/\$1/$first/;
+ }
+ elsif ($num == 2) {
+ $second =~ s/^\s+//;
+ $second =~ s/\s+$//;
+ $val =~ s/\$2/$second/;
+ }
+ else {
+ $val =~ s/\$\d+//;
+ }
+ }
+
+ $line =~ s/^(\s*)?($key\s*[;]?)//;
+ $val .= ';' if ($val ne '' && $rest =~ /;$/);
+ $line = $space . $val . $line;
+ $line =~ s/^\s+$//;
+
+ ## Fix up problems where ACE_TRY_THROW is used
+ ## on a line by itself with the parenthesis following
+ ## on the second line. The parser gets confused and
+ ## thinks it needs to replace the ACE_TRY
+ if ($key eq 'ACE_TRY') {
+ $line =~ s/try_THROW/throw/g;
+ }
+
+ my($len) = length($line);
+ if ($len > 78 || $line =~ /""/) {
+ my($level) = 0;
+ my($indouble) = 0;
+ my($pch) = '';
+ my($fix_ace_text) = undef;
+ for(my $i = 0; $i < $len; $i++) {
+ my($ch) = substr($line, $i, 1);
+ if ($ch eq '"' && $pch ne '\\') {
+ $indouble ^= 1;
+ }
+ if (!$indouble) {
+ my($nch) = substr($line, $i + 1, 1);
+ if ($ch eq ',' || ($ch eq '"' && $nch eq '"') || $ch eq '(') {
+ $level++ if ($ch eq '(');
+ $fix_ace_text = (substr($line, 0, $i) =~ /ACE_TEXT\s*$/);
+ if ($nch ne ')' && !$fix_ace_text) {
+ my($add) = "\n" . $space . (' ' x $level);
+ my($start) = 0;
+ while(substr($line, $i + 1 + $start, 1) =~ /\s/) {
+ $start++;
+ }
+ substr($line, $i + 1, $start) = $add;
+ $i += length($add) - $start;
+ $len += length($add) - $start;
+ }
+ }
+ elsif ($ch eq ')') {
+ $level--;
+ if ($fix_ace_text) {
+ if (substr($line, $i) =~ /ACE_TEXT/) {
+ my($add) = "\n" . $space . (' ' x $level);
+ my($start) = 0;
+ while(substr($line, $i + 1 + $start, 1) =~ /\s/) {
+ $start++;
+ }
+ substr($line, $i + 1, $start) = $add;
+ $i += length($add) - $start;
+ $len += length($add) - $start;
+ }
+ $fix_ace_text = undef;
+ }
+ }
+ }
+ $pch = $ch;
+ }
+ }
+
+ $mod = 1;
+ $skip_blank = 1;
+ last;
+ }
+ elsif (defined $base &&
+ index($line, ';') == -1 && $line =~ /^(\s*)?$base/) {
+ $cont_until_semicolon = 1;
+ last;
+ }
+ }
+
+ if ($line =~ s/ACE_ANY_EXCEPTION/ex/g) {
+ $mod = 1;
+ }
+ if (!$cont_until_semicolon) {
+ if ($line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL_WITH_DEFAULTS// ||
+ $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL_NOT_USED// ||
+ $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL// ||
+ $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_(PARAMETER|NOT_USED)//) {
+ my($sp) = $1;
+ if ($line =~ /^\)/) {
+ if ($lines[$#lines] =~ /\/\/.*$/ ||
+ $lines[$#lines] =~ /\/\*.*\*\/$/) {
+ $line = $sp . $line;
+ }
+ else {
+ $lines[$#lines] .= $line;
+ $line = '';
+ }
+ }
+ $mod = 1;
+ $skip_blank = 1;
+ }
+ push(@lines, $line) if ($line ne '' || !$skip_blank);
+ }
+ }
+ close($fh);
+
+ if ($mod) {
+ if (open($fh, ">$file")) {
+ foreach my $line (@lines) {
+ print $fh $line, "\n";
+ }
+ close($fh);
+ }
+ else {
+ print "ERROR: Unable to write to $file\n";
+ $status++;
+ }
+ }
+ }
+ else {
+ print "ERROR: Unable to open $file\n";
+ $status++;
+ }
+
+ return $status;
+}
+
+sub process {
+ my($arg) = shift;
+ my($status) = 0;
+
+ if (-d $arg) {
+ my($fh) = new FileHandle();
+ if (opendir($fh, $arg)) {
+ foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
+ if ($file ne '.svn') {
+ $status += process($arg . '/' . $file);
+ }
+ }
+ closedir($fh);
+ }
+ }
+ elsif ($arg =~ /\.(h|hh|hpp|hxx|hh|cpp|cxx|cc|c|C|i|ipp|inl)$/) {
+ $status += process_file($arg);
+ }
+
+ return $status;
+}
+
+sub usageAndExit {
+ print "Usage: ", basename($0), " [directories or files]\n\n",
+ "Removes all exception related ACE macros.\n";
+ exit(0);
+}
+
+# ******************************************************************
+# Main Section
+# ******************************************************************
+
+my($status) = 0;
+
+if ($#ARGV == -1) {
+ usageAndExit();
+}
+
+foreach my $arg (@ARGV) {
+ if (index($arg, '-') == 0) {
+ usageAndExit();
+ }
+ else {
+ $status += process($arg);
+ }
+}
+
+exit($status);
View Lorry Controller Status