A little tool for developers.
No longer relies on the deprecated (now) File::PathConvert module, only on core Perl libraries. This is considerably better code than I wrote in 2000 when first posted to PM.
| links last checked: 22-Jan-2004 |
|---|
#!/usr/bin/env perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if 0; # not running under some shell package main; ### # gcc-spcdmp - cleans up output from spec check on GNU C compiler suit +e. ### ## Last modified: 22 Jan 2004 16:00:52 # (c)2000,2004 Soren Andersen # Kode Kudos to Shigio Yamaguchi & Barrie Slaymaker. #======================= cvs/rcs internal data ======================= +======# ## $Source: /usr/src/repositories/cvs/perl-proj/devtools/gcc-spcdmp,v +$ ## $Date: 2004/01/22 20:51:48 $ ## $Revision: 1.4 $ ## #===================================================================== +======# require 5.005; # qr// operator. use strict; import File::Cleanspec 'concise'; # use File::Cleanspec; use Env ('SHELL','COMSPEC'); use Text::Wrap ('wrap','$columns'); use Pod::Usage 'pod2usage'; BEGIN { my( $argC,$argN ) = ( +@ARGV , $ARGV[$#ARGV] ); if( grep { $_ eq lc($argN) or $_ eq substr lc($argN)=>1 } qw/ -h -u -man -help -usage / ) { pod2usage(-verbose => 2) } elsif ($argC > 1 ) { pod2usage(1) } } ### # included module code, see File::Cleanspec which may be released # on CPAN someday (by the author of this program). ### package File::Cleanspec; require 5.002; use strict; BEGIN { use Exporter (); use vars qw (@ISA @EXPORT); @ISA = 'Exporter'; @EXPORT = 'concise'; } # set up global lexicals & their default values my $fstype = 'Unix' ; my $sep = '/' ; my $sepRE = '/' ; my $notsepRE = '[^/]' ; my $volumeRE = '' ; my $directoryRE = '(?:(?:.*/(?:\.\.?$)?)?)' ; my $isrootRE = '(?:^/)' ; my $thisDirRE = '\.' ; my $parentDir = '..' ; my $parentDirRE = '(?:\.\.)' ; my $casesensitive = 1 ; my $idempotent = 1 ; # global regexen used in the indicated routines. These # are initialized by setfstype, so they don't need to be rebuilt each +time # the routine that uses them is called. # Used in realpath() to split filenames. my $bnsRE ; # This RE matches (and saves) the portion of the string that is just b +efore the beginning of a name my $begonRE ; # This whopper of an RE looks for the pattern "name/.." if it occurs # after the beginning of the string or after the root RE, or after a s +eparator. # We don't assume that the value of $isrootRE has a trailing separator +. # It also makes sure that we aren't eliminating '../..' and './..' pat +terns # by using the negative lookahead assertion '(?!' ... ')' construct. +It also # ignores 'name/..name'. # my $nspRE ; # # Matches '..$', '../' after a root my $leading_parentRE ; # # Matches things like '/(./)+' and '^(./)+' # my $dot_sep_etcRE ; # # Matches trailing '/' or '/.' # my $trailing_sepRE ; # based on "setfstype" in File::PathConvert by # Shigio Yamaguchi & Barrie Slaymaker #****************************************************************** sub _setfstype #******************************** #****************************************************************** { my $osname = shift ; # Find the best match for OS and set up our atomic globals accordin +gly if ( $osname =~ /^(?:(ms)?(dos|win(32|nt)?))/i ) { $fstype = 'Win32' ; $sep = '/' ; $sepRE = '[\\\\/]' ; $notsepRE = '[^\\\\/]' ; $volumeRE = '(?:^(?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\ +\\\/][^\\\\/]+)?)' ; $directoryRE = '(?:(?:.*[\\\\/](?:\.\.?$)?)?)' ; $isrootRE = '(?:^[\\\\/])' ; $thisDirRE = '\.' ; $parentDir = '..' ; $parentDirRE = '(?:\.\.)' ; $casesensitive = 0 ; $idempotent = 1 ; } elsif ( $osname =~ /^MacOS$/i ) { $fstype = 'MacOS' ; $sep = ':' ; $sepRE = '\:' ; $notsepRE = '[^:]' ; $volumeRE = '(?:^(?:[^:]+:)?)' ; $directoryRE = '(?:(?:.*:)?)' ; $isrootRE = '(?:^(?=[^:].*:)?)' ; $thisDirRE = 'cantpossiblymatchthis' ; $parentDir = '' ; $parentDirRE = '(?=(?<=:):)' ; $casesensitive = 0 ; $idempotent = 0 ; } elsif ( $osname =~ /^VMS$/i ) { $fstype = 'VMS' ; $sep = '.' ; $sepRE = '[\.\]]' ; $notsepRE = '[^\.\]]' ; # volume is node::volume:, where node:: and volume: are optional + # and node:: cannot be present without volume. node can include # an access control string in double quotes. # Not supported: # quoted full node names # embedding a double quote in a string ("" to put " in) # support ':' in node names # foreign file specifications # task specifications # UIC Directory format (use the 6 digit name for it, instead +) $volumeRE = '(?:^(?:(?:[\w\$-]+(?:"[^"]*")?::)?[\w\$-]+: +)?)' ; $directoryRE = '(?:(?:\[.*\])?)' ; # Root is the lack of a leading '.', unless string is empty, whi +ch # means 'cwd', which is relative. $isrootRE = '(?:^[^\.])' ; $thisDirRE = '\[\]' ; $parentDir = '-' ; $parentDirRE = '-' ; $casesensitive = 0 ; $idempotent = 0 ; } elsif ( $osname =~ /^URL$/i ) { # URL spec based on RFC2396 (ftp://ftp.isi.edu/in-notes/rfc2396. +txt) $fstype = 'URL' ; $sep = '/' ; $sepRE = '/' ; $notsepRE = '[^/]' ; # Volume= scheme + authority, both optional $volumeRE = '(?:^(?:[a-zA-Z][a-zA-Z0-9+-.]*:)?(?://[^/?] +*)?)' ; # Directories do _not_ include the query component: we pretend t +hat # anything after a "?" is the filename or part of it. So a '/' # terminates and is part of the directory spec, while a '?' or ' +#' # terminate and are not part of the directory spec. # # We pretend that ";param" syntax does not exist # $directoryRE = '(?:(?:[^?#]*/(?:\.\.?(?:$|(?=[?#])))?)?)' ; $isrootRE = '(?:^/)' ; $thisDirRE = '\.' ; $parentDir = '..' ; $parentDirRE = '(?:\.\.)' ; # Assume case sensitive, since many (most?) are. The user can o +verride # this if they so desire. $casesensitive = 1 ; $idempotent = 1 ; } # Now assemble our composite regexps $bnsRE = '^(.*)'. $sepRE . '('. $notsepRE .'*)$' ; $leading_parentRE = '('. $isrootRE .'?)(?:'. $parentDirRE . $sepRE + .')*' .'(?:'. $parentDirRE +.'$)?' ; $trailing_sepRE = '(.)' . $sepRE . $thisDirRE . '?$' ; $begonRE = '(?:^|'. $isrootRE .'|'. $sepRE .')' ; $dot_sep_etcRE = '(' . $begonRE . ')(?:' . $thisDirRE . $sepRE . ')+'; #--------------------------------------------------------------------- +- # in english: # nothing (start of string) or root or sep (captured) # IF FOLLOWED BY something that is NOT . or .. FOLLOWED BY / (zero +-width lookahead), # FOLLOWED BY something that isn't / , FOLLOWED BY / , FOLLOWED BY + .. , FOLLOWED BY # either / or nought (end of string). $nspRE = '('. $begonRE .')' . '(?!(?:'. $thisDirRE .'|'. $parentDirRE .')' . $sepRE .')' . $notsepRE .'+' . $sepRE . $parentDirRE . '(?:'. $sepRE .'|$)' ; #--------------------------------------------------------------------- +- return $fstype ; } # based on "regularize" from File::PathConvert # by Shigio Yamaguchi & Barrie Slaymaker # (but note reordered substitutions). #****************************************************************** sub concise #******************************** #****************************************************************** { local $^W = 1; my $in = shift @_ ; # Combine idempotent separators. Do this first so all other REs o +nly # need to match one separator. Use the first sep found to preserve # backward slashes on Win32. $in =~ s/($sepRE)$sepRE+/$1/g if $idempotent ; # We do this after deleting redundant separators in order to be co +nsistent. # If a Win32 path ended in \, we want to be sure that \ is returne +d, not /. my $trailing_sep = ($in =~ /($sepRE)$sepRE*$/) ? $1 : ''; # Get rid of ./ in '^./' and '/./' $in =~ s/$dot_sep_etcRE/$1/g ; # Get rid of trailing '/' and '/.' unless it would leave an empty +string $in =~ s/$trailing_sepRE/$1/ ; # Delete all occurences of 'name/..(/|$)'. This is done with a while # loop to get rid of things like 'name1/name2/../..' ... we choose th +e pattern # name/../ as the target instead of /name/.. so as to preserve 'rootn +ess'. # see explanation of this regexp "$nspRE" above. do {} while $in =~ s/$nspRE/$1/g ; # Get rid of '../' constructs from absolute paths $in =~ s/$leading_parentRE/$1/ if ( $in =~ /$isrootRE/ ) ; # Restore trailing separator if it was lost. We do this to preserv +e # the 'dir-ness' of the path: paths that ended in a separator on e +ntry # should leave with one in case the caller is using trailing slash +es to # indicate paths to directories. $in .= $trailing_sep if ( $trailing_sep ne '' && $in !~ /$sepRE$/ ) ; return $in ; } # Executed once when module is loaded. No "1;" at last line because we + *DON'T* WANT # perl to succeed in loading the module if this sub fails. IOW, this s +hould always # return true anyway. my $detected = _setfstype($^O); ### # end of included module (package space) "File::Cleanspec" ### package main; my $setfstype = \&File::Cleanspec::_setfstype; $columns = 76; my( $specHd , $fndelim , $fh , $bg2en , @bconfig , $bctarget , $rootish , $realvol , @goods , %compo ); my $divdr = qq(\n ) . '-' x $columns . qq(\n); my $cntdefs = 0; my $sanify = {}; my $cppdefchr = qr{ [-_=0-9a-zA-Z]+ \s* }x; my $flegalchr = q{[-.\w]}; my @intro = (qq{\n GCC component tools:}); my $gcc_cmd_path = 'gcc'; do { eval "select $_ ; $| = 1 ;" } foreach qw{STDERR STDOUT}; $specHd = $fndelim = '/'; if ($ARGV[0] and $ARGV[0] eq '-demo') { # demo print STDERR " *** D E M O ***\n"; $fh = \*DATA; $specHd = '[A-Z]:'; $fndelim = quotemeta '\\'; $setfstype->( 'mswin32' ) eq 'Win32' or die "Cannot set fstype"; } elsif # we supply an alternate name for gcc invocation: ($ARGV[0]) { $gcc_cmd_path = shift @ARGV; $gcc_cmd_path =~ s@\\@/@g; } if ( (not $SHELL) or (not $ARGV[0] and ($COMSPEC && $COMSPEC=~m@(?:CMD(?:\.EXE)?|COMMAND(?:\.COM)?)@i and eval{ my $prb=`gcc -dumpmachine`; 1 if $prb =~/\-mingw/m; } )) ) { $setfstype->( 'mswin32' ); $specHd = '[A-Z]:'; $fndelim = quotemeta '\\'; } elsif ($^O =~ /cygwin/ and $SHELL and $SHELL =~ m% [[:alpha:]]{0,2}sh %x) { $specHd = $fndelim = '/'; if ($ENV{'CYGROOT'}) { $rootish = $ENV{'CYGROOT'}; } else { chomp( $rootish = `cygpath -wa /` );# print qq(\n My CygROOT: $roo +tish\n); } $realvol = substr( $rootish, 0, 2 ); $rootish = quotemeta( substr( $rootish, 3 )); $setfstype->( 'unix' ); } if (! defined $fh) { die "drat, no touch!" if system qq(touch foo.c); open SHPIPE, qq(2>&1 $gcc_cmd_path --verbose -c foo.c | ) or die qq(We haven't got a good open() here?!\n$!); $fh = \*SHPIPE; } my $re_FNstart = qq%$specHd$fndelim?$flegalchr+$fndelim\\S+%; # print STDERR "RE for paths is \"$re_FNstart\"\n"; while (<$fh>) { last if /\A\s*\Z/ and eof; my( $path , $processed , $reduced , $prepath , $whol , $pstpath , $predef , $pstdef ) = map ('',(1 .. 8)); $bg2en = 0; # s#/#\\#g; # for mswin-dos if ( /\sas(?=\s-(V|o))/ or /$re_FNstart(?=\s)/o ) # May need some work? # the above won't tolerate spaces in path specifications # (Windoze users take note!). /^(?<=\s)$specHd $flegalchr+ $fndelim + \S(?=\s) /x { chomp($path = $&); next if /as -o/ or q'"' eq substr($path, -1); chomp($whol = $_); $prepath = $` if $`; $pstpath = $' if $' and not m@\-(?:D|A)$cppdefchr@; $bg2en = 1 if $whol =~/\Q$path\E/; unless ($specHd eq '/') { $reduced = concise( $path ); # debugging stuff print STDERR qq(\n * Oops, "concise()" failed: ), $reduced, qq(\n from path: $path\n) if $reduced =~m@\Q$fndelim\E\.\.\Q$fndelim@; } elsif ($rootish) { my $cpath = concise( $path ); chomp( $reduced = `cygpath -wa $cpath` ); my $winpath = $reduced; $reduced =~s@\\@$fndelim@g; $reduced =~s@ $realvol (?:$fndelim$rootish)? @@x; $sanify->{$reduced} = $winpath; print STDERR qq(\n * Oops, failed: ), $reduced, qq(\n win path: $winpath\n) if $reduced =~m@$fndeli +m\.\.$fndelim@; } else # other uni*-like platforms .. sorry MacPerl-ites ;-( { $reduced = concise( $path ) or warn qq(\nTrouble from path spec "$path"\n); } if ( $pstpath =~ m@ -lang-c -v @ or /-(?:D|A)$cppdefchr/ ) { my @defin = qq(\n); my @other = (); push @defin, grep /\-(?:D|A)$cppdefchr/, split /\s+/, $_; push @other, grep !/\-(?:D|A)$cppdefchr/, split /\s+/, substr($_, index ($_ => '-v')); $predef = $` if $`; $pstdef = $' if $'; push @goods , qq(\n), qq(\n) , 'Default/automatic preprocessor-defined symbols:' , (map { (sprintf( "\n [% 2u] ", ++$cntdefs). $_) if $_; } grep {s@\s+\Z@@ || 1}@defin) , qq(\n\n); if (@other) { my $bopeep = 0; push @goods, "Other CPP default conditions: "; push @goods, map { s%[/\\]+%$fndelim%go; /-iprefix/ .. $bopeep++ ? ($bopeep ? concise($_) : $_) : "" }@other; push @goods, qq{\n}; } } my $comp; if ($reduced =~ m@cpp (?:\.exe|0)? \Z@x) { $comp = 'CPP' } elsif ($reduced =~ m@cc1 (?:\.exe)? \Z@x) { $comp = 'CC' } elsif ($reduced =~ m@as (?:\.exe)? \Z@x) { $comp = 'AS' } # ------------------------------------------------------------------- +- if ($comp) { $compo{$comp} = qq|$divdr $reduced| ; next } # ------------------------------------------------------------------- +- unless ($rootish) { $_ = $prepath . $reduced . $pstpath } else { $_ = $prepath . $reduced; $_ .= qq|\n ** aka |. $sanify->{$reduced} .qq| **| if exists $sanify->{$reduced}; $_ .= $pstpath; } $processed = $_; $_ = $whol .qq(\n); } # ------------------------------------------------------------------- +- my $comv; if (/^GNU CPP version/) { $comv = 'CPP' } elsif (/^GNU C version/) { $comv = 'CC' } elsif (/^GNU assembler version/) { $comv = 'AS' } elsif (/^\s*compiled by .+\.\d\.\Z/) { $comv = 'CC' } # ------------------------------------------------------------------- +- if ($comv) { my $parent = /\Q(cpplib)\E/ ? 'CC' : $comv; chomp; $compo{$parent} .= ($compo{$parent} ? qq[\n] : q[]); if (substr( $compo{$parent}, -5, 3 ) ne '---') { $compo{$parent} .= wrap(q| |,q| |,$_); }else{ substr($compo{$parent},(-1 * (3 + $columns)) ) = wrap(q| |,q| |,$_); } $compo{$parent} .= $divdr; next; } # ------------------------------------------------------------------- +- if ($processed =~ /Reading specs from/) { unshift @intro => $processed ; next ; } elsif (/\Agcc version/) { unshift @intro => q( ).$_ ; next ; } if (/with:/) { $bctarget = substr($_, rindex ($_=>' ')); substr($_, rindex ($_=>' ')) = '' if $bctarget !~ /--\S+/; push @bconfig => $_ ; next ; } elsif (/Thread model:/) { next } push @goods => ($processed ? $processed : $_); } close ($fh); # Done reading in output. # Post-process gcc & slaves output dumps. unshift @goods => ( @intro , grep { $_ } map($compo{$_} , qw(CPP CC AS)) ); # We're ready to tell all: printin (@goods, 2); printin ($divdr , map( (/^(?:Configured|Thread)/? '':' --').$_.qq{\n}, map { split /\s+--/, $_ }@bconfig ) , ($bctarget ? "target $bctarget" : "") , substr($divdr=>3), 2) if @bconfig; exit 0; sub printin { my $indent_by = pop; $indent_by = ' ' x $indent_by; foreach my $line (@_) { my $in = $line !~ m%\A\s*\Z% ? $indent_by : ""; printf STDOUT "$in%s" => $line; } } sub END { # Clean up after ourselves. unlink 'foo.c', 'foo.o'; } __DATA__ Reading specs from D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw +32msvc\2.95.2\specs gcc version 2.95.2 19991024 (release) D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\cpp. +exe -lang-c -v -iprefix D:\MinGW32\gcc-2.95.2\bin\..\lib/gcc-lib/i386 +-mingw32msvc\2.95.2\ -D__GNUC__=2 -D__GNUC_MINOR__=95 -Di386 -D_WIN32 + -DWIN32 -D__WIN32__ -D__MINGW32__=0.2 -D__MSVCRT__ -DWINNT -D_X86_=1 + -D__STDC__=1 -D__stdcall=__attribute__((__stdcall__)) -D_stdcall=__a +ttribute__((__stdcall__)) -D__cdecl=__attribute__((__cdecl__)) -D__de +clspec(x)=__attribute__((x)) -D__i386__ -D_WIN32 -D__WIN32__ -D__WIN3 +2__ -D__MINGW32__=0.2 -D__MSVCRT__ -D__WINNT__ -D_X86_=1 -D__STDC__=1 + -D__stdcall=__attribute__((__stdcall__)) -D___stdcall__=__attribute_ +_((__stdcall__)) -D__cdecl=__attribute__((__cdecl__)) -D__declspec(x) +=__attribute__((x)) -D__i386 -D__WIN32 -D__WINNT -D___stdcall=__attri +bute__((__stdcall__)) -Asystem(winnt) -Acpu(i386) -Amachine(i386) -re +map -Acpu(i386) -Amachine(i386) -Di386 -D__i386 -D__i386__ foo.c G:\T +MP\ccZhaaaa.i GNU CPP version 2.95.2 19991024 (release) (80386, BSD syntax) #include "..." search starts here: #include <...> search starts here: D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\..\. +.\..\..\include D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\..\. +.\..\..\i386-mingw32msvc\include D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\incl +ude End of search list. The following default directories have been omitted from the search pa +th: /gcc-2.95.2/lib/gcc-lib/i386-mingw32msvc/2.95.2/../../../../include/g +++-3 /usr/local/i386-mingw32/include End of omitted list. D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\cc1. +exe G:\TMP\ccZhaaaa.i -quiet -dumpbase foo.c -version -o G:\TMP\ccOpa +aaa.s GNU C version 2.95.2 19991024 (release) (i386-mingw32msvc) compiled by + GNU C version 2.95.2 19991024 (release). as -o foo.o G:\TMP\ccOpaaaa.s
In reply to gcc_spec_check by Intrepid
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |