gSTLFilt.pl 71 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063
  1. ################################################################################################################
  2. # gSTLFilt.pl: BD Software STL Error Message Decryptor (a Perl script)
  3. # This version supports the gcc 2/3/4 C++ compiler/library
  4. # It was tested under:
  5. # DJGPP 2.95.2
  6. # MinGW gcc 2.95.2, 3.2.3, 3.4.5, 4.1.1
  7. # TDM gcc 4.2.2
  8. #
  9. $STLFilt_ID = "BD Software STL Message Decryptor v3.10 for gcc 2/3/4";
  10. #
  11. # (c) Copyright Leor Zolman 2002-2008. Permission to copy, use, modify, sell and
  12. # distribute this software is granted provided this copyright notice appears
  13. # in all copies. This software is provided "as is" without express or implied
  14. # warranty, and with no claim as to its suitability for any purpose.
  15. #
  16. #################################################################################################################
  17. # Visit www.bdsoft.com for information about BD Software's on-site training seminars #
  18. # in C, C++, STL, Perl, Unix Fundamentals and Korn Shell Programming #
  19. #################################################################################################################
  20. #
  21. # For quick installation instructions for the STL Error Decryptor, see QUICKSTART.txt.
  22. # For manifest and other general information, see README.txt
  23. #
  24. # (Note: hard tab setting for this source file is: 4)
  25. #
  26. # Purpose: Transform STL template-based typenames from gcc error messages
  27. # into a minimal, *readable* format. We might lose some details...
  28. # but retain our sanity!
  29. #
  30. # This script may be used in several different ways:
  31. # 1) With the "Proxy C++" program, C++.EXE (from the command-line or from within Dev-CPP)
  32. # 2) With a batch/shell script driver for command-line use...
  33. # For Windows: The companion batch file GFILT.BAT is provided as a sample driver for this script
  34. # For Unix/Linux/OS X: The companion shell script "gfilt" is provided as a sample driver for
  35. # this script, allowing arbitrary intermixing of compiler and Decryptor options
  36. # on the command line.
  37. #
  38. # Acknowledgements:
  39. # Scott Meyers taught his "Effective STL" seminar, where the project began.
  40. # Thomas Becker wrote and helps me maintain the Win32 piping code used throughout both C++.CPP and
  41. # the Perl scripts, keeping everyone talking despite all the curves thrown him (so far) by
  42. # ActiveState and Microsoft. THANK YOU, Thomas!
  43. # David Abrahams designed the long-typename-wrapping algorithm and continues to contribute actively
  44. # to its evolution.
  45. # David Smallberg came up with the "Proxy compiler" idea (but blame me for the name).
  46. #
  47. # For the complete list of folks whose feedback and de-bugging help contributed to this
  48. # package, and also for the list of programming courses BD Software offers, see README.txt.
  49. #
  50. #
  51. #################################################################################################################
  52. #
  53. # Script Options
  54. # --------------
  55. #
  56. # Command line options are case insensitive, and may be preceded by either '-' or '/'.
  57. # The Proxy C++, if being used, supplies many of these options as per settings in the
  58. # Proxy-gcc.INI configuration file.
  59. #
  60. # Note that some of the Decryptor's behavior is controlled via command-line options,
  61. # while other behavior may only be configured via hard-wired variable settings. Please
  62. # examine the entire "User-Configurable Settings" section below to become familiar with
  63. # all the customizable features.
  64. #
  65. # General options:
  66. #
  67. # -iter:x Set iterator policy to x, where x is s[short], m[edium] or l[ong]
  68. # (See the assignments of $def_iter_policy and $newiter below for details)
  69. #
  70. # -cand:x Set "candidates" policy to x, where x is L[ong], M[edium] or S[hort]
  71. # (See the assignment of $def_cand_policy below for details)
  72. #
  73. # -hdr:x Set STL header policy to x or nn, where x is L[ong], M[edium], or S[hort],
  74. # -hdr:nn or nn is the # of errors to show in a cluster
  75. # -hdr:LD Dave Abrahams re-ordering mode 1 (see below)
  76. # -hdr:LD1 save as above
  77. # -hdr:LD2 Dave Abrahams re-ordering mode 2
  78. # (See the assignment of $def_hdr_policy below for details)
  79. #
  80. # -with:x Set "with clause" substitution policy to x, where x is L[ong] or S[hort]
  81. # (See the assignment of $def_with_policy below for details)
  82. #
  83. # -path:x Set "show long pathnames" policy to x, where x is l[ong] or s[hort]
  84. # (See the assignment of $def_path_policy below for details)
  85. #
  86. # -showback:x Set backtrace policy: Y (default) or N (suppress all backtrace lines)
  87. #
  88. # -width:nn Set output line width (break message lines at this column, or 0 for NO wrapping)
  89. #
  90. # -lognative Log all native messages to NativeLog.txt (for de-bugging)
  91. #
  92. # -banner:x Show Decryptor banner line: Y (default) or N
  93. #
  94. # -nullarg:xxx Add xxx to the list of "null argument" typenames that get stripped from the
  95. # trailing portion of template argument lists. (See also the initializations of
  96. # variable @nullargs). xxx must be fully qualified (including namespace).
  97. #
  98. # if xxx is 'clear', the null argument list is emptied; subsequent -nullarg
  99. # specification appearing on the command line will work, but not the defaults
  100. # as per the initialization of @nullargs below (unless they're re-specified
  101. # using the -nullarg option later on the commmad line.)
  102. #
  103. # Options supporting long typename wrapping:
  104. #
  105. # (Note: If output width is set to 0, line wrapping is disabled and the
  106. # following options have NO EFFECT)
  107. #
  108. # -break:x Break algorithm: D[ave Abrahams] (default) or P[lain]
  109. # The "Dave" option wraps long complex typenames in a way that
  110. # makes it easier to see parameter lists at various nesting depths.
  111. #
  112. # -cbreak:x Comma break: B = break before commas (default), A = break after
  113. # [applies only in -break:D mode]
  114. #
  115. # -closewrap:x Wrap before unmatched closing delimiters: Y (default) or N
  116. # [applies only in -break:D mode]
  117. #
  118. # -meta:x Configure for metaprogramming [Y] or vanilla wrapping [N] as follows:
  119. #
  120. # -meta:y (or just -meta) forces -break:D, and forces -cbreak and
  121. # -closewrap options according to values specified in the $meta_y_cbreak
  122. # and $meta_y_closewrap variable initializations, respectively.
  123. #
  124. # -meta:n forces -break:P (-cbreak and -closewrap don't apply)
  125. #
  126. # In either case, if the output width hasn't yet been set to a non-zero
  127. # value, it is set to 80 (choosing a wrapping flavor makes no sense
  128. # with wrapping disabled); this may be overridden by a subsequent -width
  129. # option.
  130. #
  131. # Note: If no -meta option is present, the default values for -break,
  132. # -cbreak and -closewrap are determined by the user-configurable
  133. # settings of $break_algorithm, $comma_wrap and $close_wrap below.
  134. #
  135. # Note also that -meta is not configurable from the INI files, because
  136. # it is intended as a command-line "override" mechanism. The individual
  137. # settings of -break, -cbreak and -closewrap, however, *are* (and apply
  138. # only when the /meta option is not used.)
  139. #
  140. #################################################################################################################
  141. # User-configurable settings (use UPPER CASE ONLY for all alphabetics here (except $newiter):
  142. #
  143. ####################################################################################
  144. # The following twelve settings may be overridden by options on
  145. # the command line (either explicitly, or when conveyed by the
  146. # Proxy C++ from settings in Proxy-gcc.INI):
  147. # default iterator policy (/iter:x option):
  148. $def_iter_policy = 'L'; # 'L' (Long): NEVER remove iterator type name qualification
  149. # 'M' (Medium): USUALLY remove iterator type name qualification
  150. # leave intact when iter type may be significant
  151. # to the diagnostic
  152. # 'S' (Short): ALWAYS remove iterator type name qualification
  153. $def_cand_policy = 'L'; # default candidate policy (/cand:x option):
  154. # 'L' (long): Retain candidate list (same as: 'Y')
  155. # 'M' (medium): Suppress candidates, but tell how many were suppressed
  156. # 'S' (short): completely ignore candidate list (same as: 'N')
  157. $def_hdr_policy = 'LD2'; # default standard header messages policy (/hdr:x option):
  158. # 'L' (long): Retain all messages referring to standard header files (same as 'Y')
  159. # 'M' (medium): Retain only the first $headers_to_show messages in each cluster
  160. # 'S' (short): Discard all messages referring to standard header files (same as 'N')
  161. # 'LD[1]' (long, Dave Abrahams re-ordering mode 1):
  162. # actual error msg moves to front of instantiation backtrace
  163. # 'LD2' (long, Dave Abrahams re-ordering mode 2):
  164. # as above, with trigger line duplicated before the backtrace
  165. $def_with_policy = 'S'; # default "with clause" substitution policy (/with:x option):
  166. # 'L' (long): Do NOT substitute in template parameters in "with" clauses
  167. # 'S' (short): Do substitute template parameters in "with" clauses
  168. $def_path_policy = 'S'; # default long path policy (/path:x option):
  169. # 'L' (long): Retain entire pathname in all cases (same as 'Y')
  170. # 'S' (short): Discard all except base name from pathnames (same as 'N')
  171. # [NOTE: Use L if you rely upon your IDE to locate errors in source files]
  172. $def_hdrs_to_show = 1; # Default number of header messages to show for 'M' header policy
  173. $banner = 'N'; # Show banner with Decryptor ID by default (/banner option)
  174. $break_algorithm = 'D'; # P[lain] or D[ave Abrahams] line-breaking algorithm (/break:x option)
  175. # (Note: line-breaking of any kind happens only if $output_width is non-zero)
  176. $comma_wrap = 'B'; # wrap lines B[efore] or A[fter] commas. (/cbreak:x option)
  177. # (Applies in Dave mode only.)
  178. $close_wrap = 'Y'; # Force a break before close delimiters
  179. # whose open is not on the same line (/closewrap:x option)
  180. # (Applies in Dave mode only.)
  181. $output_width = 80; # wrap at 80 columns by default (/width:nn option)
  182. $show_backtraces = 'Y'; # show (Y) or suppress (N) backtrace messages (/showback:x option)
  183. #####################################################################################
  184. # The remaining settings are controlled strictly by their assigned
  185. # value below (no corresponding command-line options offered):
  186. $newiter = 'iter'; # ('iter' or 'IT' or...) shorten the word "iterator" to this
  187. # Note: /iter:L forces $newiter to be 'iterator' (no filtering)
  188. $tabsize = 4; # number of chars to incrementally indent lines
  189. $advise_re_policy_opts = 1; # remind folks they can use /hdr:L and /cand:L to see more message details
  190. $nix_only_once = 1; # suppress "undefined identifiers shown only once..." messages
  191. $reformat_linenumbers = 0; # 1 to reformat lines numbers to LZ's preferred style (may conflict with
  192. # cursor-placement mechanisms in some editors/IDE's)
  193. $smush_amps_and_stars = 0; # 1 leaves asterisks/ampersands adjacent to preceding identifiers;
  194. # 0 inserts a space between
  195. $space_after_commas = 0; # 1 to force spaces after commas, 0 not to
  196. $meta_y_cbreak = 'B'; # /meta:y forces this value for cbreak
  197. $meta_y_closewrap = 'Y'; # /meta:y forces this values for closewrap
  198. $wrap_own_msgs = 0; # wrap STL Decryptor messages to same output width
  199. # as errors (1) or don't (0)
  200. $keep_stdns = 0; # 0 to remove "std::" and related prefixes, 1 to retain them.
  201. # NOTE: if set to 1, STL-related filtering will *not* work (for now). This option
  202. # is designed for use in conjunction with /break:D to retain maximum detail in
  203. # metaprogramming-style messages, rather than for use with STL library messages.
  204. $show_internal_err = 1; # If set to 0, suppresses delimiter mismatch errors. Please leave at 1,
  205. # and contact me as per the emitted instructions in the case of an
  206. # internal error.
  207. # default list of names of trailing type names to be stripped from the end of
  208. # argument lists (the -nullarg:xxx command line option allows additional names to
  209. # be added to the list, or for the these default ones to be cleared out):
  210. @nullargs = qw(boost::tuples::null_type mpl_::void_ mpl_::na boost::detail::variant::void\d+);
  211. # (Designed primarly for use with boost libraries tuple, mpl, etc...)
  212. #@nullargs = qw(); # to totally disable the null args stripping feature by default, uncomment this
  213. # line and comment out the initialization of @nullargs above.
  214. #
  215. # END of user-configurable settings (change anything below here AT YOUR OWN RISK.)
  216. #################################################################################################################
  217. $| = 1; # force output buffer flush after every line
  218. $iter_policy = $def_iter_policy; # default iterator policy
  219. $dave_move = 0; # true for /hdr:LD1
  220. $dave_rep = 0; # true for /hdr:LD2
  221. $in_backtrace = 0; # not processing a backtrace right now
  222. if ("\u$def_hdr_policy" =~ 'LD[12]?')
  223. {
  224. $dave_move = 1;
  225. $dave_rep = 0;
  226. $dave_rep = 1 if "\u$def_hdr_policy" eq 'LD2';
  227. $def_hdr_policy = 'L';
  228. }
  229. $header_policy = $def_hdr_policy; # default std. header message policy
  230. $with_policy = $def_with_policy; # default "with clause" substitution policy
  231. $headers_to_show = $def_hdrs_to_show; # number of headers to show for 'M' header policy
  232. $candidate_policy = $def_cand_policy; # default candidate policy (gcc only)
  233. $pathname_policy = $def_path_policy; # default pathname policy (gcc only)
  234. $lognative = 0; # by default, not logging native messages
  235. $suppressed_headers = 0; # true when we've suppressed at least one stdlib header
  236. $suppressed_candidates = 0; # true when we've suppressed at least one template candidate
  237. $pdbg = 0; # true to show print trace
  238. $wrapdbg = 0; # de-bug wrap loop
  239. $movedbg = 0; # de-bug Dave mode reordering
  240. $delimdbg = 0; # de-bug /wrap:D mode delimiter parsing
  241. $optdbg = 0; # show value of all command-line modfiable options
  242. $choked = 0; # haven't choked yet with an internal error
  243. sub scanback;
  244. sub println;
  245. sub print2;
  246. sub break_and_print;
  247. sub break_and_print_plain;
  248. sub break_and_println_plain;
  249. sub break_and_print_fragment;
  250. sub lognative_header;
  251. sub showkey;
  252. # Little hack to avoid "Exiting subroutine via next" warnings on internal error:
  253. sub NoWarn
  254. {
  255. $msg = shift (@_);
  256. print "$msg" if $msg !~ /Exiting subroutine via next/;
  257. }
  258. $SIG{__WARN__} = "NoWarn";
  259. @save_args = @ARGV; # lognative_header uses this
  260. while (@ARGV) # process command-line options
  261. {
  262. if ($ARGV[0] =~ /^[\/-]iter:([SML])[A-Z]*$/i) # allow command-line iterator policy
  263. { # specification of form: /iter:x
  264. print "$ARGV[0] " if $optdbg;
  265. $iter_policy = "\u$1";
  266. $newiter = 'iterator' if $iter_policy eq 'L';
  267. shift;
  268. next;
  269. }
  270. if ($ARGV[0] =~ /^[\/-]cand:([YNSML])[A-Z]*$/i) # allow candidate policy
  271. { # specification of form: /cand:x
  272. print "$ARGV[0] " if $optdbg;
  273. $candidate_policy = "\u$1";
  274. $candidate_policy =~ tr/NY/SL/;
  275. shift;
  276. next;
  277. }
  278. if ($ARGV[0] =~ /^[\/-]with:([YNSL])[A-Z]*$/i) # allow with clause policy
  279. { # specification of form: /with:x
  280. print "$ARGV[0] " if $optdbg;
  281. $with_policy = "\u$1";
  282. $with_policy =~ tr/NY/LS/;
  283. shift;
  284. next;
  285. }
  286. if ($ARGV[0] =~ /^[\/-]hdr:L(D[12]?)$/i) # detect special "Dave Abrahams" header policy
  287. { # specifications of form: /hdr:LD /hdr:LD1 /hdr:LD2
  288. print "$ARGV[0] " if $optdbg;
  289. $header_policy = "L";
  290. $dave_move = 1; # moving error line to before the trace
  291. $dave_rep = 0;
  292. $dave_rep = 1 if "\u$1" eq "D2"; # replicating trigger line
  293. shift;
  294. next;
  295. }
  296. if ($ARGV[0] =~ /^[\/-]hdr:([YNSML])[a-ce-z]*$/i) # allow standard header policy
  297. { # specification of form: /hdr:x
  298. print "$ARGV[0] " if $optdbg;
  299. $header_policy = "\u$1";
  300. $header_policy =~ tr/NY/SL/;
  301. $headers_to_show = 0 if $header_policy eq 'S';
  302. $dave_move = 0;
  303. $dave_rep = 0;
  304. shift;
  305. next;
  306. }
  307. if ($ARGV[0] =~ /^[\/-]hdr:(\d+)/i) # allow standard header policy
  308. { # specification of form: /hdr:nn
  309. print "$ARGV[0] " if $optdbg;
  310. $header_policy = 'M';
  311. $headers_to_show = $1;
  312. shift;
  313. next;
  314. }
  315. if ($ARGV[0] =~ /^[\/-]path:([SL])[A-Z]*$/i) # allow pathname policy
  316. { # specification of form: /path:x
  317. print "$ARGV[0] " if $optdbg;
  318. $pathname_policy = "\u$1";
  319. $pathname_policy =~ tr/NY/SL/;
  320. shift;
  321. next;
  322. }
  323. if ($ARGV[0] =~ /^[\/-]banner:?([YN]?)[A-Z]*$/i) # banner:Y or N
  324. { # (just "/banner" means Y)
  325. print "$ARGV[0] " if $optdbg;
  326. $banner = "\u$1";
  327. $banner = 'Y' if $banner eq "";
  328. shift;
  329. next;
  330. }
  331. if ($ARGV[0] =~ /^[\/-]showback:?([YN]?)[A-Z]*$/i) # showback:Y or N
  332. { # (just "/showback" means Y)
  333. print "$ARGV[0] " if $optdbg;
  334. $show_backtraces = "\u$1";
  335. $show_backtraces = 'Y' if $show_backtraces eq "";
  336. shift;
  337. next;
  338. }
  339. if ($ARGV[0] =~ /^[\/-]width:(\d+)/i) # allow line output width spec
  340. { # of form: /width:n
  341. print "$ARGV[0] " if $optdbg;
  342. $output_width = $1;
  343. shift;
  344. next;
  345. }
  346. if ($ARGV[0] =~ /^[\/-]break:([DP])[A-Z]*$/i) # break: D or P
  347. {
  348. print "$ARGV[0] " if $optdbg;
  349. $break_algorithm = "\u$1";
  350. shift;
  351. next;
  352. }
  353. if ($ARGV[0] =~ /^[\/-]cbreak:([AB])[A-Z]*$/i) # comma break: B or A
  354. {
  355. print "$ARGV[0] " if $optdbg;
  356. $comma_wrap = "\u$1";
  357. shift;
  358. next;
  359. }
  360. if ($ARGV[0] =~ /^[\/-]closewrap:?([YN]?)[A-Z]*$/i) # closewrap:Y or N
  361. { # (just "/closewrap" means Y)
  362. print "$ARGV[0] " if $optdbg;
  363. $close_wrap = "\u$1";
  364. $close_wrap = 'Y' if $close_wrap eq "";
  365. shift;
  366. next;
  367. }
  368. if ($ARGV[0] =~ /^[\/-]nullarg:(.*)/i) # add to list of "null arg" identifiers
  369. {
  370. print "$ARGV[0] " if $optdbg;
  371. if ($1 =~ /^clear$/i)
  372. {
  373. @nullargs = (); # "clear" means clear out null arg list
  374. }
  375. else
  376. {
  377. push @nullargs, $1; # any other name is appened to list
  378. }
  379. shift;
  380. next;
  381. }
  382. if ($ARGV[0] =~ /^[\/-]meta:?([YN]?)[A-Z]*$/i) # meta:Y or N
  383. { # (just "/meta" means Y)
  384. if ("\u$1" =~ /^N/)
  385. {
  386. $break_algorithm = 'P';
  387. }
  388. else
  389. {
  390. $break_algorithm = 'D';
  391. $comma_wrap = $meta_y_cbreak;
  392. $close_wrap = $meta_y_closewrap;
  393. }
  394. $output_width = 80 if $output_width == 0;
  395. shift;
  396. next;
  397. }
  398. if ($ARGV[0] =~ /^[\/-]lognative/i) # allow log native msgs option
  399. { # of form: /lognative
  400. print "$ARGV[0] " if $optdbg;
  401. $lognative = 1;
  402. shift;
  403. next;
  404. }
  405. println "Warning: unrecognized gSTLFilt2.pl command line option: $ARGV[0]\n";
  406. shift;
  407. }
  408. # List of "standard" header files names:
  409. @keywords = qw(algo algorithm algobase bitset cassert cctype cerrno cfloat ciso646
  410. climits clocale cmath complex csetjmp csignal cstdarg stdarg cstddef stddef
  411. cstdio stdio cstdlib stdlib cstring ctime time cwchar cwtype cxxabi deque editbuf exception exception_defines
  412. fstream fstream.h functional hashtable hash_map hash_set heap iomanip
  413. ios iosfwd iostream iostream istream iterator limits list locale
  414. map memory new new numeric ostream queue rope set slist
  415. pair sstream stack stdexcept streambuf streambuf_iterator string
  416. strstream strstream stream_iterator typeinfo utility valarray vector
  417. basic_ios basic_string boost_concept_check char_traits codecvt concept_check
  418. cpp_type_traits fpos functexcept generic_shadow gslice gslice_array indirect_array
  419. ios_base localefwd stringfwd locale_facets mask_array pthread_allocimpl slice slice_array
  420. type_traits valarray_array valarray_meta bastring complext fcomplex ldcomplex
  421. std_valarray straits strfile tempbuf alloc floatio math
  422. array random regex type_traits tuple unordered_map unordered_set
  423. cfenv cinttypes cstdbool cstdint ctgmath
  424. );
  425. # Put 'em in a hash for rapid searching:
  426. for (@keywords)
  427. {
  428. $keywords{$_}++;
  429. }
  430. print "\n" if $optdbg;
  431. $tab = " " x $tabsize;
  432. print "\n\n" . ("=" x $output_width) . "\n\n" if $pdbg or $wrapdbg or $movedbg or $delimdbg;
  433. #
  434. # This sections builds the $t ("type") regex from the ground up.
  435. # After it is built, the component variables (except for $id) are not used again.
  436. #
  437. $sid = '\b[a-zA-Z_]\w*'; # pattern for a simple identifier or keyword
  438. $id = "(?:$sid\:\:)*$sid"; # simple id preceded by an optional namespace qualifier
  439. $p = '(?: ?\*)*'; # suffix for "ptr", "ptr to ptr", "ptr to ptr to ptr", ad nauseum.
  440. $idp = "(?:$id )*$id ?$p ?"; # one or more identifiers/keywords with perhaps some *'s after
  441. # simple id or basic template spec
  442. $cid = "(?:$idp(?: ?const ?\\*? ?)?|$id<$idp(?: ?const ?\\*? ?)?(?:, ?$idp(?: ?const ?\\*? ?)?)*>$p) ?";
  443. # a cid or template type with 1+ cid's as parameters
  444. $t = "(?:$cid|$id<$cid(?:, ?$cid)*>$p|$id<$id<$cid>$p(?:, ?$id<$cid>$p)* ?>$p)";
  445. println "$STLFilt_ID" if ($banner eq 'Y');
  446. showkey $output_width if $pdbg;
  447. lognative_header if $lognative;
  448. $doing_candidates = 0;
  449. $doing_stl_headers = 0;
  450. $save_filename = '';
  451. $this_is_gcc3 = 0;
  452. $saw_instantiated = 0;
  453. #
  454. # Data structures supporting the Dave Abrahams mode line break algorithm:
  455. #
  456. @open_delims = ('(', '{', '<');
  457. @close_delims= (')', '}', '>');
  458. for (@open_delims) # list of "open" delimiters
  459. {
  460. $open_delims{$_}++;
  461. }
  462. for (@close_delims) # list of "close" delimiters
  463. {
  464. $close_delims{$_}++;
  465. }
  466. # create "opposites" table, mapping each delimiter to its complement:
  467. for ($i = 0; $i < @open_delims; $i++)
  468. {
  469. $opps{$open_delims[$i]} = $close_delims[$i];
  470. $opps{$close_delims[$i]} = $open_delims[$i];
  471. }
  472. # The following state varaibles are used for Dave-mode line re-ordering:
  473. $pushed_back_line = "";
  474. $displaying_error_msg = 0; # true if displaying actual error message of backtrace in re-order mode
  475. $last_within_context = ""; # save "within this context" lines to detect duplicates and strip them
  476. #
  477. # NOTE: We cannot use a main loop of the form
  478. #
  479. # while( <> )
  480. #
  481. # because of ActivePerl's way of handling input from Win32 pipes
  482. # connected to STDIN. (EOF is treated like an ordinary character.
  483. # In particular, it doesn't get read unless FOLLOWED by a newline.
  484. # Yeah, great, EOF followed by a newline.)
  485. #
  486. MAIN_LOOP:
  487. while ( 1 )
  488. {
  489. if ($pushed_back_line ne "")
  490. {
  491. $_ = $pushed_back_line;
  492. $pushed_back_line = "";
  493. }
  494. else
  495. {
  496. # Read the first char of the next line to see if it equals EOF.
  497. # If we're the ones who write the code that writes to STDIN,
  498. # we can guarantee that EOF is always preceded by a newline.
  499. #
  500. # We must do this in a loop, because if the next line is empty,
  501. # then we have not read the first char of the next line, but
  502. # the entire next line.
  503. #
  504. $newlines = "";
  505. CHECK_FOR_EOF_LOOP:
  506. while( 1 )
  507. {
  508. # Read one char.
  509. $nextchar = "";
  510. $numRead = read STDIN, $nextchar, 1;
  511. # Normally, perl will return an undefined value from read if the next
  512. # character was EOF. ActivePerl will simply read the EOF like any other
  513. # character. Since we know that one of the newlines was ours, we print one
  514. # less newline than we have seen. NOTE: It is possible that we have seen no
  515. # newline at all. This happens if the CL output has no newline at the end.
  516. # In that case, we have appended a newline, and that's good.
  517. if (1 != $numRead or $nextchar eq "\032")
  518. {
  519. if ($newlines ne "")
  520. {
  521. chop $newlines;
  522. print $newlines;
  523. }
  524. last MAIN_LOOP;
  525. }
  526. else # Else, if we have read a newline, we store it for later output and continue reading.
  527. {
  528. if ($nextchar eq "\n")
  529. {
  530. $newlines = $newlines . "\n";
  531. }
  532. # Else, if we have read something that's neither a newline nor EOF, we print
  533. # the accumulated newlines and proceed to read and process the next line.
  534. else
  535. {
  536. print $newlines;
  537. last CHECK_FOR_EOF_LOOP;
  538. }
  539. }
  540. }
  541. # Read the next line, prepend the first char, which has already been read.
  542. $_ = <STDIN>;
  543. # If the read failed, the pipe must have broken.
  544. if (!defined $_)
  545. {
  546. print "\nSTL Decryptor: Input stream terminated abnormally (broken pipe?)\n";
  547. last MAIN_LOOP;
  548. }
  549. $_ = $nextchar . $_;
  550. }
  551. #
  552. # Done with special EOF-processing-enabled input handling.
  553. # Now process the line (in $_):
  554. #
  555. $save_line_for_dbg = $_; # in case of a panic error
  556. print LOGNATIVE $_ if $lognative; # log native message if requested
  557. print "DBG: Next line to be processed:\n$_\n" if $movedbg;
  558. s/{anonymous}/anonymous/g; # massage anonymous namespace specs to qualify as identifiers
  559. s/<unnamed>/unnamed/g;
  560. $obj = 0; # by default, not object file message
  561. $obj = 1 if /\.o(bj)?\b/i or /\.a\b/i; # set $obj if an object or lib file
  562. if ($obj)
  563. {
  564. print "************** PRINT DBG 1 **************\n" if $pdbg;
  565. if (/(.*\):\s*)([\S].*)/) # look for possibly-mangled name followed by additional text...
  566. {
  567. $before = $1;
  568. $after = "$2\n";
  569. break_and_print_plain "$before"; # print the part containing possible mangled-name-from-hell
  570. $_ = $after; # and process the rest normally.
  571. }
  572. else
  573. {
  574. break_and_print_plain "$_"; # print entire line containing possible mangled-name-from-hell
  575. next;
  576. }
  577. }
  578. next if $show_backtraces eq 'N' and (/\binstantiated from\b/ or /^\s*from /);
  579. # get rid of useless messages from gcc
  580. if ($nix_only_once)
  581. {
  582. next if /\(Each undeclared identifier is reported only once/;
  583. next if /for each function it appears in\.\)/;
  584. }
  585. $has_lineno = 0;
  586. $has_lineno = 1 if /^(.*\.(cpp|cxx|cc|h|hpp|tcc)\:(\d+\:) ?)/;
  587. # strip prefix of form:
  588. if (/^(.*\.(cpp|cxx|cc|h|hpp|tcc)\:(\d+\:)? ?)/ or # "pathname.h:n: " or
  589. (/^((?:[a-zA-Z]\:)?[^:]*\b(\w+)(\.\w+)?\:(\d+\:)? ?)/ and exists $keywords{$2})) # std header
  590. {
  591. $prefix = "$1"; # and restore it later
  592. s/^\Q$prefix//; # remove during filtering
  593. }
  594. else
  595. {
  596. $prefix = ""; # null prefix if none detected
  597. }
  598. # test if we're looking at a message referring to a standard header
  599. # (note that the candidate policy trumps the header policy):
  600. $needs_stripping = ($prefix =~ /stl_[a-zA-Z]\w*\.h:/i or
  601. ($prefix =~ m#([/\\])include\1(?:.*\1)*(\w+)# and exists $keywords{$2}));
  602. $this_is_an_stl_header = ($needs_stripping and
  603. !$doing_candidates and ($_ !~ /candidates are\:/));
  604. # strip message referring to standard headers if header_policy is S:
  605. if ($this_is_an_stl_header)
  606. {
  607. ++$doing_stl_headers;
  608. next if $header_policy eq 'S'; # skip all headers if using 'S' header policy
  609. # skip all but first $headers_to_show if policy is 'M'
  610. next if $doing_stl_headers > $headers_to_show and $header_policy eq 'M';
  611. }
  612. # if 'M' or 'S' header policy, tell how many skipped:
  613. if (!$this_is_an_stl_header and ($doing_stl_headers > ($headers_to_show)) and $header_policy ne 'L')
  614. {
  615. println " [STL Decryptor: Suppressed " .
  616. ($doing_stl_headers - $headers_to_show) .
  617. ($header_policy eq 'M' ? " more " : " ") .
  618. "STL standard header message" .
  619. (($doing_stl_headers - $headers_to_show) != 1 ? "s" : "") . "]";
  620. $suppressed_headers = 1;
  621. }
  622. $doing_stl_headers = 0 if !$this_is_an_stl_header;
  623. # gcc: strip pathname from deadly-long stdlib file paths as per $pathname_policy:
  624. if ($pathname_policy eq 'S' and $needs_stripping)
  625. {
  626. $preprefix = ""; # special case: preserve leading " from " phrase
  627. if ($prefix =~ /^(.* from )/)
  628. {
  629. $preprefix = $1;
  630. $prefix =~ s/^.* from //;
  631. }
  632. if ($prefix =~ /$sid\.(h|hpp|tcc|cpp|cxx|cc)\:/)
  633. { # case where there's an extension
  634. $prefix =~ s/.*($sid\.(h|hpp|tcc|cpp|cxx|cc))\:/$preprefix$1:/;
  635. }
  636. else
  637. { # case where there's (perhaps) no extension
  638. $prefix =~ s/^(?:[a-zA-Z]\:)?[^:]*\b(\w+(\.\w+)?\:(\d+\:)? ?)/$preprefix$1/;
  639. }
  640. }
  641. # save filename, if any
  642. if ($prefix =~ /^($sid\.(h|hpp|tcc))\:/)
  643. {
  644. $filename = $1; # save file basename
  645. }
  646. else
  647. {
  648. $filename = 'No filename';
  649. }
  650. if ($candidate_policy ne 'L' and /candidates are:/)
  651. {
  652. $doing_candidates++;
  653. $save_filename = $filename;
  654. $suppressed_candidates = 1;
  655. next;
  656. }
  657. $this_is_gcc3 = 1 if $doing_candidates and / /;
  658. # skip all messages referring to "candidates" (if req'd):
  659. if ($candidate_policy ne 'L' and $doing_candidates and
  660. ($this_is_gcc3 and / /) or (!$this_is_gcc3 and $filename eq $save_filename))
  661. {
  662. $doing_candidates++;
  663. next;
  664. }
  665. if (((!$this_is_gcc3 and $filename ne $save_filename) or $this_is_gcc3) and $doing_candidates)
  666. {
  667. println " [STL Decryptor: Suppressed $doing_candidates 'candidate' line" .
  668. ($doing_candidates != 1 ? "s" : "") . "]"
  669. if $candidate_policy eq 'M';
  670. $doing_candidates = 0;
  671. }
  672. s/no matching function for call to/No match for/;
  673. ###################################################################################################
  674. # Do 'with' clause processing, transforming into plain-Jane type specifications:
  675. if ($with_policy eq 'S')
  676. {
  677. # temporary eliminate [##] sequences:
  678. @dims = ();
  679. $dim_counter = 1;
  680. while (/(\[(\d*)])/)
  681. {
  682. $old = $1;
  683. $sub = $2;
  684. s/\Q$old/zzz-$dim_counter-$sub-zzz/;
  685. push @dims, $sub;
  686. $dim_counter++;
  687. }
  688. while (/(.*)( \[with ([^]]*)])/)
  689. {
  690. $text = $1; # the original message text with placeholder names
  691. $keyclause = $2; # the "with [...]" clause
  692. $keylist = $3; # just the list of key/value mappings
  693. chop $keylist if substr($keylist, -1, 1) eq ']';
  694. %map = (); # clear the hash of key/value pairs
  695. while($keylist =~ /(\w+) ?=/)
  696. {
  697. $key = $1;
  698. $pos = $start = index($keylist, $key) + length($key) + 1;
  699. if (substr($keylist, $pos, 1) eq '=')
  700. { $pos++; $start++; }
  701. if (substr($keylist, $pos, 1) eq ' ')
  702. { $pos++; $start++; }
  703. $depth = 0; # count <'s and >'s
  704. $previous = ' ';
  705. while ($pos <= length($keylist))
  706. {
  707. $next = substr ($keylist, $pos++, 1);
  708. last if $depth == 0 and ($next eq ',' or ($next eq ']' and $previous ne '[')); # ignore "[]"
  709. $previous = $next;
  710. $depth++ if $next =~ /[<\[\(]/;
  711. $depth-- if $next =~ /[>\]\)]/;
  712. }
  713. $value = substr($keylist, $start, $pos - $start - 1);
  714. $map{$key} = $value;
  715. last if $pos > length($keylist);
  716. $keylist = substr($keylist, $pos);
  717. }
  718. # Apply substitutions to the original text fragment:
  719. $newtext = $text;
  720. while(($key, $value) = each(%map))
  721. {
  722. $newtext =~ s/\b$key\b/$value/g;
  723. }
  724. # Replace the original message text with the expanded version:
  725. s/\Q$text/$newtext/;
  726. # Delete the key/value list from the message:
  727. s/\Q$keyclause//;
  728. }
  729. # restore [###] clauses:
  730. $dim_counter = 1;
  731. foreach $dim (@dims)
  732. {
  733. s/zzz-$dim_counter-$dim-zzz/[$dim]/g;
  734. $dim_counter++;
  735. }
  736. }
  737. # End 'with' clause processing
  738. #############################################################################################
  739. # eliminate standard namespace qualifiers (for now, required for STL filtering):
  740. s/\bstd(ext)?\:\://g unless $keep_stdns;
  741. s/\b__gnu_cxx\:\://g unless $keep_stdns;
  742. s/note: //; # WTF? It's just noise.
  743. s/typename //g; # ditto
  744. # The following section strips out the "class" keyword when it is part
  745. # of a type name, but not when it is part of the 'prose' of a message.
  746. # To do this, we only strip the word "class" when it follows an
  747. # odd-numbered single quote (1st, 3rd, 5th,
  748. $out = ""; # accumulate result into $out
  749. $old = $_;
  750. while (1)
  751. {
  752. if (($pos = index ($old, "`")) == -1) # index of next opening quote
  753. { # if none,
  754. $out .= $old; # we're done
  755. last;
  756. }
  757. $out .= substr($old, 0, $pos + 1, ""); # splice up to & including the "'" to $out
  758. $pos = index($old, "'"); # index of next closing quote in $out
  759. $txt = substr($old, 0, $pos + 1, ""); # splice from $old into $txt
  760. $txt =~ s/\bclass //g if !/\btypedef\b/; # filter out "class" from $txt
  761. $out .= $txt; # concatenate result to cumulative result
  762. } # loop for next fragment
  763. $_ = $out; # done; update entire current line
  764. # s/\bclass //g if !/typedef/; # strip "class" except in typedef errors
  765. s/\bstruct ([^'])/$1/g if !/typedef/; # don't strip "struct" for *anonymous* structs or typedefs
  766. s/\b_STLD?\:\://g unless $keep_stdns; # for STLPort
  767. # simplify the ubiquitous "vanilla" string and i/ostreams (w/optional default allocator):
  768. s/\b(_?basic_(string|if?stream|of?stream|([io]?stringstream)))<(char|wchar_t), ?(string_)?char_traits<\4>(, ?__default_alloc_template<(true|false), ?0>)? ?>\:\:\1/$2::$2/g;
  769. s/\b_?basic_(string|if?stream|of?stream|([io]?stringstream))<(char|wchar_t), ?(string_)?char_traits<\3>(, ?__default_alloc_template<(true|false), ?0>)? ?>/$1/g;
  770. s/\b(_?basic_(string|if?stream|of?stream|([io]?stringstream)))<(char|wchar_t), ?(string_)?char_traits<\4>(, allocator<\4>)? ?>\:\:\1/$2::$2/g;
  771. s/\b_?basic_(string|if?stream|of?stream|([io]?stringstream))<(char|wchar_t), ?(string_)?char_traits<\3>(, allocator<\3>)? ?>/$1/g;
  772. s/\b([io])stream_iterator<($t), ?($t), ?char_traits<\3>, ?($t)>/$1stream_iterator<$2>/g;
  773. s/\b__normal_iterator<const $t, ?($t)>\:\:__normal_iterator\(/string::const_iterator(/g;
  774. s/\b__normal_iterator<$t, ?($t)>\:\:__normal_iterator\(/string::iterator(/g;
  775. # The following loop repeats until no transformations occur in the last complete iteration:
  776. for ($pass = 1; ;$pass++) # pass count (for de-bugging purposes only)
  777. {
  778. my $before = $_; # save the current line; keep looping while changes happen
  779. #
  780. # Handle allocator clauses:
  781. #
  782. # delete allocators from template typenames completely:
  783. $has_double_gt = 0;
  784. $has_double_gt++ if />>/;
  785. s/allocator<($t)>::rebind<\1>::other::($id)/allocator<$1>::$2/g;
  786. s/\b,? ?allocator<$t ?>(,(0|1|true|false)) ?>/$2>/g;
  787. s/, ?allocator<$id<($t), ?allocator<\1> ?> ?>//g;
  788. s/, ?allocator<$t> ?>/>/g;
  789. # remove allocator clauses
  790. # gcc 4.x allocator types
  791. s/, ?allocator<($t) ?>\:\:rebind<\1 ?>\:\:other>/>/g;
  792. # remove allocator clauses if the message doesn't refer to an allocator explicitly:
  793. unless (/' to '.*allocator</ or /allocator<$t>\:\:/)
  794. {
  795. s/, ?allocator<$t ?> ?//g; # the leading comma allows the full spec.
  796. s/, ?const allocator<$t ?> ?&//g; # to appear in the error message details
  797. s/,? ?(const )?$t\:\:allocator_type ?&//g;
  798. }
  799. if (!$has_double_gt)
  800. {
  801. while (/>>/)
  802. {
  803. s/>>/> >/g;
  804. }
  805. }
  806. # gcc deque, deque iterators:
  807. s/\bdeque<($t),0>/deque<$1>/g;
  808. s/\b_Deque_iterator<($t), ?\1 ?&, ?\1 ?[*&](, ?0)?>\:\:_Deque_iterator ?\(/deque<$1>::iterator(/g;
  809. s/\b_Deque_iterator<($t), ?\1 ?&, ?\1 ?[*&](, ?0)?>/deque<$1>::iterator/g;
  810. s/\b_Deque_iterator<($t), ?const \1 ?&, ?const \1 ?[*&](,0)?>\:\:_Deque_iterator ?\(/deque<$1>::const_iterator(/g;
  811. s/\b_Deque_iterator<($t), ?const \1 ?&, ?const \1 ?[*&](,0)?>/deque<$1>::const_iterator/g;
  812. # gcc list iterators:
  813. s/\b_List_iterator<($t), ?(const )?\1 ?&, ?(const )?\1 ?\*>\:\:_List_iterator ?\(/list<$1>::iterator(/g;
  814. s/\b_List_iterator<($t), ?(const )?\1 ?&, ?(const )?\1 ?\*>/list<$1>::iterator/g;
  815. s/\b_List_iterator<($t)>\:\:_List_iterator\(/list<$1>::iterator(/g;
  816. s/\b_List_iterator<($t)>/list<$1>\:\:iterator/g;
  817. s/\b_List_const_iterator<($t)>\:\:_List_const_iterator ?\(/list<$1>::const_iterator(/g;
  818. s/\b_List_const_iterator<($t)>/list<$1>::const_iterator/g;
  819. s/_List_node<($t)> ?\*/list<$1>::iterator/g;
  820. s/_List_node_base ?\*/iterator/g;
  821. s/_List_const_iterator/const_iterator/g;
  822. s/_List_iterator/iterator/g;
  823. # gcc slist iterators:
  824. s/\b_Slist_iterator<($t), ?\1 ?&, ?\1 ?\*>\:\:_Slist_iterator ?\(/slist<$1>::iterator(/g;
  825. s/\b_Slist_iterator<($t), ?const \1 ?&, ?const \1 ?\*>\:\:_Slist_iterator ?\(/slist<$1>::const_iterator(/g;
  826. s/\b_Slist_iterator<($t), ?\1 ?&, ?\1 ?\*>/slist<$1>::iterator/g;
  827. s/\b_Slist_iterator<($t), ?const \1 ?&, ?const \1 ?\*>/slist<$1>::const_iterator/g;
  828. s/\b_Slist_node<($t)> ?\*/slist<$1>::iterator/g;
  829. # gcc vector iterator:
  830. s/\b__normal_iterator<($t) ?\*, vector<\1 ?> ?>\:\:__normal_iterator ?\(/vector<$1>::iterator(/g;
  831. s/\b__normal_iterator<($t) ?\*, vector<\1 ?> ?>/vector<$1>::iterator/g;
  832. s/\b__normal_iterator<($t) const ?\*, vector<\1 ?> ?>\:\:__normal_iterator ?\(/vector<$1>::const_iterator(/g;
  833. s/\b__normal_iterator<const ($t) ?\*, ?vector<\1 ?> ?>\:\:__normal_iterator ?\(/vector<$1>::const_iterator(/g;
  834. s/\b__normal_iterator<($t) const ?\*, vector<\1 ?> ?>/vector<$1>::const_iterator/g;
  835. s/\b__normal_iterator<const ($t) ?\*, ?vector<\1 ?> ?>/vector<$1>::const_iterator/g;
  836. # gcc map:
  837. s/\b_Rb_tree<($t), ?pair<const \1, ?($t)>, ?_Select1st<pair<const \1, ?\2> ?> ?>/map<$1,$2>/g;
  838. s/\b_Rb_tree<($t), ?pair<const \1, ?($t)>, ?_Select1st<pair<const \1, ?\2> ?>, ($t) ?>/map<$1,$2,$3>/g;
  839. # s/\b_Rb_tree<($t), ?pair<const \1, ?($t)>, ?_Select1st<pair<const \1, ?\2> > ?>/map<$1,$2>/g;
  840. s/\b_Rb_tree<($t), ?pair<const \1, ?($t)>, ?_Select1st<pair<const \1, ?\2> ?>, ($t)::rebind<pair<const \1, ?\2> >::other>/map<$1,$2,$3>/g;
  841. # gcc map/multimap iterators:
  842. s/\b_Rb_tree<($t), ?pair<const \1, ?($t)>, ?_Select1st<pair<const \1, ?\2> ?>::rebind<pair<const \1, ?\2> >::other>/multimap<$1,$2>/g;
  843. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t) ?> ?>\:\:_Rb_tree_iterator\(const _Rb_tree_iterator<pair<const \1 ?, ?\2 ?> ?>&\)/gen_map<$1,$2>::iterator(const gen_map<$1,$2>::iterator &)/g;
  844. s/\b_Rb_tree_const_iterator<pair<const ($t) ?, ?($t) ?> ?>\:\:_Rb_tree_const_iterator\(const _Rb_tree_const_iterator<pair<const \1 ?, ?\2 ?> ?>&\)/gen_map<$1,$2>::const_iterator(const gen_map<$1,$2>::const_iterator &)/g;
  845. s/\b_Rb_tree_const_iterator<pair<const ($t) ?, ?($t) ?> ?>\:\:_Rb_tree_const_iterator\(const _Rb_tree_iterator<pair<const \1 ?, ?\2 ?> ?>&\)/gen_map<$1,$2>::const_iterator(const gen_map<$1,$2>::iterator &)/g;
  846. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t) ?> ?>\:\:_Rb_tree_iterator\(_Rb_tree_node<pair<const \1, ?\2 ?> ?>\*\)/gen_map<$1,$2>::iterator/g;
  847. s/\b_Rb_tree_const_iterator<pair<const ($t) ?, ?($t) ?> ?>\:\:_Rb_tree_const_iterator\(const _Rb_tree_node<pair<const \1, ?\2 ?> ?>\*\)/gen_map<$1,$2>::iterator/g;
  848. s/\b_Rb_tree_iterator<pair<($t) ?const, ?($t) ?> ?>/gen_map<$1,$2>::iterator/g;
  849. s/\b_Rb_tree_const_iterator<pair<($t) ?const, ?($t) ?> ?>/gen_map<$1,$2>::const_iterator/g;
  850. s/\b_Rb_tree_node<pair<const ($t), ?($t) ?> ?> ?\*/gen_map<$1,$2>::iterator/g;
  851. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t)>, ?pair<const \1, ?\2> ?&, ?pair<const \1, ?\2> ?\*>\:\:_Rb_tree_iterator ?\(/gen_map<$1,$2>::iterator(/g;
  852. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t)>, ?pair<const \1, ?\2> ?&, ?pair<const \1, ?\2> ?\*>/gen_map<$1,$2>::iterator/g;
  853. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t)>, ?const pair<const \1, ?\2> ?&,const pair<const \1, ?\2> ?\*>\:\:_Rb_tree_iterator ?\(/gen_map<$1,$2>::const_iterator(/g;
  854. s/\b_Rb_tree_iterator<pair<($t) ?const, ?($t)>, ?pair<\1 ?const, ?\2> ?&, ?pair<\1 ?const, ?\2> ?\*>\:\:_Rb_tree_iterator ?\(/gen_map<$1,$2>::const_iterator(/g;
  855. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t)>, ?const pair<const \1, ?\2> ?&,const pair<const \1, ?\2> ?\*>/gen_map<$1,$2>::const_iterator/g;
  856. s/\b_Rb_tree_iterator<pair<($t) ?const, ?($t)>, ?pair<\1 ?const, ?\2> ?&, ?pair<\1 ?const, ?\2> ?\*>/gen_map<$1,$2>::const_iterator/g;
  857. s/\b_Rb_tree_iterator<pair<const ($t) ?, ?($t)> ?>/gen_map<$1,$2>::iterator/g;
  858. s/\b_Rb_tree_const_iterator<pair<const ($t) ?, ?($t)> ?>/gen_map<$1,$2>::const_iterator/g;
  859. # gcc set/multiset/map/multimap iterator (who knows, lol?)
  860. s/\b_Rb_tree_iterator\(($t)\)/gen_set_or_map::iterator($1)/g;
  861. s/\b_Rb_tree_const_iterator<($t)>\:\:_Rb_tree_const_iterator\(/gen_set_or_map<$1>::const_iterator(/g;
  862. s/\b_Rb_tree_const_iterator<($t)>/gen_set_or_map<$1>::const_iterator/g;
  863. s/\b_Rb_tree_const_iterator\(($t)\)/gen_set_or_map::const_iterator($1)/g;
  864. # Since the same iterator type is used for both set and multiset, we just
  865. # say "gen_set<T>::iterator" to mean the "GENERIC" set/multiset iterator type:
  866. # gcc set/multiset:
  867. s/\b_Rb_tree<($t), ?\1, ?_Identity<$t>, ?($t)>/gen_set<$1,$2>/g;
  868. s/\b_Rb_tree<($t), ?\1, ?_Identity<$t>>/gen_set<$1>/g;
  869. # gcc set/multiset iterator:
  870. s/\b_Rb_tree_iterator<($t), ?const \1 ?&, ?const \1 ?\*>::_Rb_tree_iterator ?\(/gen_set<$1>::iterator(/g;
  871. s/\b_Rb_tree_iterator<($t), ?const \1 ?&, ?const \1 ?\*>/gen_set<$1>::iterator/g;
  872. s/\b_Rb_tree_iterator<($t) \*, ?\1 ?\*const &, ?\1 ?\*const \*>::_Rb_tree_iterator ?\(/gen_set<$1>::iterator(/g;
  873. s/\b_Rb_tree_iterator<($t) \*, ?\1 ?\*const &, ?\1 ?\*const \*>/gen_set<$1>::iterator/g;
  874. s/[`']\b_Rb_tree_const_iterator ?<($t)>\:\:_Rb_tree_const_iterator\(const _Rb_tree_node<($t)> ?\*\)'/gen_set<$1>::const_iterator/g;
  875. s/[`']\b_Rb_tree_iterator ?\(($t)\)'/gen_set<$1>::iterator/g;
  876. s/[`']\b_Rb_tree_const_iterator ?\(($t)\)'/gen_set<$1>::const_iterator/g;
  877. s/\b_Rb_tree_iterator ?\(($t)\)/gen_set<$1>::iterator/g;
  878. s/\b_Rb_tree_const_iterator ?\((const $t)\)/gen_set<$1>::const_iterator/g;
  879. s/\b_Rb_tree_iterator ?<($t)>/gen_set<$1>::iterator/g;
  880. s/\b_Rb_tree_const_iterator ?<($t)>/gen_set<$1>::const_iterator/g;
  881. s/\bconst _Rb_tree_node<($t) ?> ?\*/gen_set<$1>::const_iterator/g;
  882. s/\b_Rb_tree_node<($t)> ?\*/gen_set<$1>::iterator/g;
  883. # STLPort /gcc hash_set/_multiset:
  884. s/\b(hash_(?:multi)?)set<($t)(, ?hash<\2 ?>)? ?(, ?equal_to<\2 ?>)? ?>/$1set<$2>/g;
  885. s/\bhashtable<($t), ?\1, ?hash<\1 ?>, ?_Identity<\1 ?>, ?$t>/gen_hash_set<$1>/g;
  886. # gcc hash_map/multimap:
  887. s/\b(hash_(?:multi)?)map<($t), ?($t), ?hash<\2 ?>, ?($t)>/$1map<$2,$3>/g;
  888. # gcc hash_set/hash_multiset iterator:
  889. s/\b_Hashtable_const_iterator<($t), ?\1, ?hash<\1 ?>, ?_Identity<\1 ?>, ?$t>\:\:_Hashtable_const_iterator ?\(/gen_hash_set($1):const_iterator(/g;
  890. s/\b_Hashtable_const_iterator<($t), ?\1, ?hash<\1 ?>, ?_Identity<\1 ?>, ?$t>/gen_hash_set($1):const_iterator/g;
  891. s/\b_Hashtable_iterator<($t), ?\1, ?hash<\1 ?>, ?_Identity<\1 ?>, ?$t>\:\:_Hashtable_iterator ?\(/gen_hash_set($1):iterator(/g;
  892. s/\b_Hashtable_iterator<($t), ?\1, ?hash<\1>, ?_Identity<\1>, ?$t>/gen_hash_set($1):iterator/g;
  893. # gcc hash_map/hash_multimap:
  894. s/\bhashtable<(pair<const ($t), ?($t)>), ?\2, ?hash<\2 ?>, ?_Select1st<\1 ?>, ?$t ?>/gen_hash_map<$2,$3>/g;
  895. # gcc hash_set/hash_multiset value_type:
  896. s/\bhashtable<($t), ?\1, ?hash<\1>, ?_Identity<\1>, ?$t>::value_type/$1/g;
  897. # STLPort/gcc hash_map/_multimap iterators under VC7 (same "GENERIC" iterator approach as above):
  898. s/\b_Hashtable_iterator<pair<const ($t), ?($t)>, ?\1, ?hash<\1 ?>, ?_Select1st<pair<const \1, ?\2> ?>, ?equal_to<\1 ?> ?>\:\:_Hashtable_iterator\(/gen_hash_map<$1,$2>::iterator(/g;
  899. s/\b_Hashtable_const_iterator<pair<const ($t), ?($t)>, ?\1, ?hash<\1 ?>, ?_Select1st<pair<const \1, ?\2> ?>, ?equal_to<\1 ?> ?>\:\:_Hashtable_const_iterator\(/gen_hash_map<$1,$2>::const_iterator(/g;
  900. s/\b_Hashtable_iterator<pair<const ($t), ?($t)>, ?\1, ?hash<\1 ?>, ?_Select1st<pair<const \1, ?\2> ?>, ?equal_to<\1 ?> ?>/gen_hash_map<$1,$2>::iterator/g;
  901. s/\b_Hashtable_const_iterator<pair<const ($t), ?($t)>, ?\1, ?hash<\1 ?>, ?_Select1st<pair<const \1, ?\2> ?>, ?equal_to<\1 ?> ?>/gen_hash_map<$1,$2>::const_iterator/g;
  902. # simplify default comparison function objects, leave others intact:
  903. s/, ?_?less<$t ?>//g;
  904. s/, ?Comp<$t ?>//g; # STLPort's default comparison function
  905. last if $before eq $_; # keep looping if substitutions were actually made
  906. }
  907. # reverse iterators:
  908. s/\breverse_iterator<($t)::iterator ?>/$1::reverse_iterator/g;
  909. s/\breverse_iterator<($t)::const_iterator ?>/$1::const_reverse_iterator/g;
  910. s/\bconst_reverse_iterator\:\:reverse_iterator/const_reverase_iterator/g;
  911. # reduce iterators according to $iter_policy:
  912. $olditer = '(reverse_)?(bidirectional_)?((back_)?insert_)?iterator';
  913. if ($iter_policy eq 'M') # policy 'M': USUALLY remove:
  914. {
  915. unless (/( of type|' to '|from ')$t\:\:(const_)?$olditer/ # Shorten to $newiter and
  916. or /iterator' does/) # *remove* the base type completely...
  917. { # as long as the error message doesn't
  918. s/$t\:\:((const_)?$olditer)\b/$1/g; # mention iterators!
  919. }
  920. }
  921. elsif ($iter_policy eq 'S') # policy 'S': ALWAYS remove:
  922. {
  923. s/$t\:\:((const_)?$olditer)\b/$1/g; # remove the base type completely
  924. }
  925. # All policies (including 'L'):
  926. s/\biterator\b/$newiter/g;
  927. s/\b(const_|reverse_|const_reverse_)iterator\b/$1$newiter/g;
  928. # remove trailing "null args" from template parameter lists:
  929. foreach $name (@nullargs)
  930. {
  931. s/(, ?$name ?)* ?>/>/g;
  932. }
  933. # reduce "double" constructor names 'T::T' to just 'T':
  934. s/[`']string\:\:string([\('])/'string$1/g;
  935. s/[`'](.*)\:\:\1([\('])/'$1$2/g;
  936. # deal with some other non-critical (and often not even very aesthetic) spaces (or lack thereof):
  937. s/>>>>>([\(:',*&])/> > > > >$1/g; # put spaces between the close brackets
  938. s/>>>>([\(:',*&])/> > > >$1/g;
  939. s/>>>([\(:',*&])/> > >$1/g;
  940. if (/(.)>>(.)/) # careful, ">>" could be operator...
  941. {
  942. $before = $1;
  943. $after = $2;
  944. s/(.)>>([ \(:',*&])/$1> >$2/g unless (/operator ?>>/ or ($before eq ' ' and $after eq ' '));
  945. }
  946. s/([^> ]) >([^>=])/$1>$2/g; # remove space before '>' (unless between another '>' or '>=')
  947. s/([\w>])([&*])/$1 $2/g if !$smush_amps_and_stars; # conditionally force space between identifier and '*' or '&'
  948. s/,([^ ])/, $1/g if $space_after_commas; # add space *after* a comma, however, if desired.
  949. s/ initializing argument / init. arg /;
  950. # and FINALLY, print out the result of all transformations, preceded by saved prefix:
  951. $_ = $prefix . $_;
  952. s/\: /:/ if $break_algorithm eq 'D'; # lose "candidate" alignment in "Dave" wrap mode
  953. # reformat line number indicator
  954. s/\:(\d+)/($1)/g if $reformat_linenumbers;
  955. if ($dave_move)
  956. {
  957. print "DBG: A\n" if $movedbg;
  958. $has_from = /^\s*from /;
  959. if (!$in_backtrace)
  960. {
  961. print "DBG: B\n" if $movedbg;
  962. if (/:\s+In\b/i or /^\s*In file included from/)
  963. {
  964. $in_backtrace = 1; # template instantiation backtrace?
  965. print "DBG: C (in_backtrace set to 1)\n" if $movedbg;
  966. @backtrace = ();
  967. }
  968. }
  969. elsif (/instantiated\s+from\s+here/)
  970. {
  971. print "DBG: D\n" if $movedbg;
  972. $saved_trigger = $_;
  973. }
  974. elsif (/instantiated\s+from\s+[`']/) #` Fix syntax hilighting for emacs
  975. {
  976. $saw_instantiated = 1;
  977. print "DBG: E (saw_instantiated set to 1)\n" if $movedbg;
  978. }
  979. elsif (/^\s*from .*[,:]$/)
  980. {
  981. $in_backtrace = 2; # header backtrace
  982. print "DBG: F (in_backtrace set to 2)\n" if $movedbg;
  983. }
  984. else # we've come to the end.
  985. {
  986. print "DBG: G\n" if $movedbg;
  987. # if we've already begun displaying the final error message:
  988. if ($displaying_error_msg)
  989. {
  990. if (substr($_, 0, 1) =~ /\s/ or /within this context/) # if we see a line beginning with whitespace, it is a continuation of the actual error message:
  991. {
  992. if (/within this context/)
  993. {
  994. next if $last_within_context eq $_; # strip consecutive identical "within this context" lines (gcc bug?)
  995. $last_within_context = $_;
  996. }
  997. break_and_print $_;
  998. next;
  999. }
  1000. else # if we see a line not starting with whitespace, finalize the re-order mode processing:
  1001. {
  1002. $last_within_context = ""; # reset "within this context" duplicate detection mechanism
  1003. break_and_print (shift @backtrace); # print 1st line of backtrace
  1004. # if replicating trigger, do it:
  1005. break_and_print $saved_trigger if $dave_rep and $saw_instantiated;
  1006. $backtrace[$#backtrace] =~ s/:$// # if header file backtrace, strip trailing
  1007. if $in_backtrace == 2 and @backtrace; # colon from last line
  1008. foreach $line (@backtrace) # now emit the accumulated backtrace
  1009. {
  1010. break_and_print $line;
  1011. }
  1012. print "\n";
  1013. $in_backtrace = 0;
  1014. print "DBG: I\n" if $movedbg;
  1015. $displaying_error_msg = 0;
  1016. $last_within_context = "";
  1017. $pushed_back_line = $_;
  1018. next;
  1019. }
  1020. }
  1021. if ($saw_instantiated or ($in_backtrace == 2 and $has_lineno and !$has_from))
  1022. {
  1023. print "DBG: H\n" if $movedbg;
  1024. print "************** PRINT DBG 2 **************\n" if $pdbg;
  1025. print "\n"; # let's set the "deep" error sequence apart
  1026. break_and_print $_; # print the first line of the actual error first
  1027. $displaying_error_msg = 1; # and go into displaying error message mode until we see a line beginning with non-ws
  1028. next;
  1029. }
  1030. elsif ($in_backtrace == 1) # template backtrace "false alarm"?
  1031. {
  1032. print "DBG: J\n" if $movedbg;
  1033. break_and_print (shift @backtrace); # yes.
  1034. $in_backtrace = 0; # reset for another round
  1035. }
  1036. }
  1037. print "DBG: K\n" if $movedbg;
  1038. if ($in_backtrace)
  1039. {
  1040. print "DBG: L\n" if $movedbg;
  1041. push @backtrace, $_;
  1042. next;
  1043. }
  1044. }
  1045. print "************** PRINT DBG 3 **************\n" if $pdbg;
  1046. break_and_print "$_";
  1047. }
  1048. if ($displaying_error_msg)
  1049. {
  1050. break_and_print (shift @backtrace); # print 1st line of backtrace
  1051. # if replicating trigger, do it:
  1052. break_and_print $saved_trigger if $dave_rep and $saw_instantiated;
  1053. $backtrace[$#backtrace] =~ s/:$// # if header file backtrace, strip trailing
  1054. if $in_backtrace == 2 and @backtrace; # colon from last line
  1055. foreach $line (@backtrace) # now emit the accumulated backtrace
  1056. {
  1057. break_and_print $line;
  1058. }
  1059. print "\n";
  1060. print "DBG: I2\n" if $movedbg;
  1061. }
  1062. close LOGNATIVE if $lognative; # close native messages logfile if active
  1063. if ($doing_candidates and $candidate_policy eq 'M')
  1064. {
  1065. println " [STL Decryptor: Suppressed $doing_candidates 'candidate' line" .
  1066. ($doing_candidates != 1 ? "s" : "") . "]";
  1067. }
  1068. else
  1069. {
  1070. # if 'M' or 'S' header policy, tell how many skipped:
  1071. if (($doing_stl_headers > $headers_to_show) and $header_policy ne 'L')
  1072. {
  1073. println " [STL Decryptor: Suppressed " .
  1074. ($doing_stl_headers - $headers_to_show) .
  1075. ($header_policy eq 'M' ? " more " : " ") .
  1076. "STL standard header message" .
  1077. (($doing_stl_headers - $headers_to_show) != 1 ? "s" : "") . "]";
  1078. $suppressed_headers = 1;
  1079. }
  1080. }
  1081. if ($advise_re_policy_opts and ($suppressed_headers or $suppressed_candidates))
  1082. {
  1083. print "\nSTL Decryptor reminder";
  1084. print "s" if $suppressed_headers and $suppressed_candidates;
  1085. println ":";
  1086. println " Use the /hdr:L option to see all suppressed standard lib headers" if $suppressed_headers;
  1087. println " Use the /cand:L option to see all suppressed template candidates" if $suppressed_candidates;
  1088. }
  1089. if ($choked)
  1090. {
  1091. print "\n***************************************************************************\n";
  1092. print "A non-fatal, internal STL Decryptor error has occurred.\n";
  1093. if ($show_internal_err)
  1094. {
  1095. print "It should have said as much somewhere above, and then emitted the \n";
  1096. print "partially-filtered line.\n";
  1097. }
  1098. print "Please look for a file just created named NativeLog.txt,\n";
  1099. print "and email this file to leor\@bdsoft.com. This will greatly assist me\n";
  1100. print "to understand and try to correct the problem. Thank you!\n";
  1101. print "***************************************************************************\n";
  1102. }
  1103. exit 0;
  1104. sub break_and_print {
  1105. my $line = shift(@_);
  1106. if ($output_width == 0 or ($break_algorithm eq 'P' and length($line) < $output_width))
  1107. {
  1108. $line =~ s/\s+\n/\n/g; # delete trailing space on a line
  1109. print "************** PRINT DBG 4 **************\n" if $pdbg;
  1110. print "$line";
  1111. return;
  1112. }
  1113. if ($break_algorithm eq 'P')
  1114. {
  1115. print "************** PRINT DBG 5 **************\n" if $pdbg;
  1116. break_and_print_plain "$line";
  1117. return;
  1118. }
  1119. $nesting_level = 0; # track combined nesting level for () [] <> {}
  1120. $in_quotes = 0; # not in quotes
  1121. WRAPLOOP:
  1122. for ($frag_count = 0; ;$frag_count++)
  1123. {
  1124. print "\nDBG: Top of WRAPLOOP, line to process is: '$line'\n" if $wrapdbg;
  1125. print "DBG: top of WRAPLOOP a: frag_count = $frag_count, nesting_level = $nesting_level\n" if $wrapdbg;
  1126. print "DBG: tabsize = $tabsize, in_quotes = $in_quotes\n" if $wrapdbg;
  1127. $indentation = $nesting_level; # save indentation at start of every line
  1128. $width = $output_width - ($nesting_level * $tabsize);
  1129. print "DBG: top of WRAPLOOP: indentation = $indentation\n" if $wrapdbg;
  1130. print "DBG: width now $width \n" if $wrapdbg;
  1131. $line =~ s/^\s*//; # delete leading spaces
  1132. $line =~ s/,([^ \t])/, $1/g; # make sure commas are followed by a space for gcc2
  1133. if ($frag_count > 0) # make sure only 1st line of message hugs left margin
  1134. {
  1135. $indentation++;
  1136. $width -= $tabsize;
  1137. }
  1138. $at_left = 0; # recognize when there's no nested parens
  1139. $at_left = 1 if ($close_wrap eq 'N' and
  1140. ($frag_count == 0 or ($frag_count > 0 and $nesting_level == 1)));
  1141. # Preprocess line, creating table mapping close- to open-parens:
  1142. print "\n\nDBG: line to process (width = $width, nesting_level = $nesting_level, in_quotes = $in_quotes):\n$line" if $pdbg or $delimdbg;
  1143. showkey $width if $pdbg or $delimdbg;
  1144. $first_unmatched_close = $width; # position of first unmatched close paren
  1145. $unmatched_close_nesting = $nesting_level; # the nesting level below which we'll consider a close paren to be unmatched
  1146. $initial_close = 0; # assume first character is not a close paren
  1147. @delims = (); # list of unmatched open delims
  1148. @delim_index = (); # for each open, record its position
  1149. @nesting_key = (); # record nesting level at each char position
  1150. @quoting_key = (); # record whether in quotations at each char position
  1151. # for each closer, we'll record the position of the corresponding opener in @delim_opener
  1152. # begin by resetting each position:
  1153. for ($i = 0; $i < length($line); $i++)
  1154. {
  1155. $delim_opener[$i] = -1;
  1156. }
  1157. for ($pos = 0; $pos < $width and $pos < length($line); $pos++)
  1158. {
  1159. $c = substr($line, $pos, 1);
  1160. print "DBG: delimiter de-bugging, column pos = $pos (char there = '$c')\n" if $delimdbg;
  1161. if (exists $open_delims{$c})
  1162. {
  1163. $before = ' ';
  1164. $before = substr($line, $pos-1, 1) if $pos > 0;
  1165. $beforetext = "";
  1166. $beforetext = substr($line, $pos - 8, 8) if ($pos >= 8); # looking for "operator"
  1167. $after = ' ';
  1168. if ($pos < (length($line) - 1))
  1169. {
  1170. $after = substr($line, $pos+1, 1);
  1171. $aftertext = substr($line, $pos+1);
  1172. }
  1173. # Exclude some special cases:
  1174. if (!($before eq '`' and $after eq '\'') and # `paren'
  1175. !($before eq ' ' and $after eq ' ' and $c eq '<') and # <space> < <space> (relop)
  1176. !( ($before eq $c or $after eq $c) and ($c eq '<')) and # two <'s in a row
  1177. !($c eq '<' and $after eq '=') and # <=
  1178. !($c eq '<' and ($after eq '"' or $before eq '"')) and # "< or <"
  1179. !($c eq '(' and $after eq ')') and # ()
  1180. !(($c eq '<' or $c eq '(') and $beforetext =~ /\boperator ?<?$/) and # operator<, operator<<, operator()
  1181. !($aftertext =~ /^first use/)
  1182. )
  1183. {
  1184. print "DBG: matched opening delim '$c', aftertext = '$aftertext'\n" if $delimdbg;
  1185. $nesting_level++;
  1186. push @delims, $c;
  1187. push @delim_index, $pos;
  1188. }
  1189. }
  1190. elsif (exists $close_delims{$c})
  1191. {
  1192. $before = ' ';
  1193. $before = substr($line, $pos-1, 1) if $pos > 0;
  1194. $beforetext = "";
  1195. $beforetext = substr($line, $pos - 10, 10) if ($pos >= 10); # looking for "operator"
  1196. $after = ' ';
  1197. if ($pos < (length($line) - 1))
  1198. {
  1199. $after = substr($line, $pos+1, 1);
  1200. $aftertext = substr($line, $pos+1);
  1201. }
  1202. # Exclude some special cases:
  1203. if (!($before eq '`' and $after eq '\'') and # `paren'
  1204. !($beforetext =~ /\s$/ and $c eq '>' and $after eq '>') and # whitespace >>
  1205. !($beforetext =~ /\s>$/ and $c eq '>' and $aftertext =~ /^\s/) and # whitespace >> whitespace
  1206. !($c eq '>' and $after eq '=') and # >=
  1207. !($c eq '>' and ($after eq '"' or $before eq '"')) and # "> or >"
  1208. !($c eq '>' and $beforetext =~ /\boperator ?>?$/) and # operator> or operator>>
  1209. !($c eq ')' and $before eq '(') and # ()
  1210. !($aftertext =~ /^first use/) and
  1211. !($before eq '-' and $c eq '>')) # special case: -> operator (!!)
  1212. {
  1213. print "DBG: matched closing delim '$c', aftertext = '$aftertext'\n" if $delimdbg;
  1214. $nesting_level--;
  1215. # If the nesting_level ever falls below its level at
  1216. # the beginning of the line, we have an unmatched
  1217. # close paren and we must force a break there.
  1218. if ($pos == 0)
  1219. {
  1220. # initial close delimiters don't count, we'll break after the nesting falls again
  1221. $initial_close = 1;
  1222. $unmatched_close_nesting--;
  1223. }
  1224. elsif ($close_wrap eq 'Y' and $in_quotes
  1225. and $first_unmatched_close > $pos
  1226. and $nesting_level < $unmatched_close_nesting)
  1227. {
  1228. $first_unmatched_close = $pos;
  1229. }
  1230. if (@delims > 0)
  1231. {
  1232. if ($c ne $opps{$delims[$#delims]})
  1233. {
  1234. if ($show_internal_err)
  1235. {
  1236. if (!$lognative)
  1237. {
  1238. lognative_header;
  1239. print LOGNATIVE "Raw unprocessed input line:\n$save_line_for_dbg\n\n"; # write out the unprocessed offending line }
  1240. $lognative = 1;
  1241. }
  1242. print LOGNATIVE "\nThe line at the point of the error was:\n$line\n";
  1243. print LOGNATIVE " " x $pos . "^\n";
  1244. print LOGNATIVE "\nNesting key: " . "@nesting_key\n";
  1245. print LOGNATIVE "\nSTL Decryptor ERROR: the char '$c' (position $pos) DOESN'T MATCH DELIMITER '$delims[$#delims]'!\n";
  1246. $choked = 1;
  1247. print "\n";
  1248. print " [An Internal STL Decryptor error has occurred while processing\n";
  1249. print " the line that follows. Note that the line has not been successfully\n";
  1250. print " wrapped, but substitutions should still be intact:]\n\n";
  1251. }
  1252. print "$line\n"; # write out the unwrapped line
  1253. next MAIN_LOOP;
  1254. }
  1255. else
  1256. {
  1257. pop @delims;
  1258. $delim_opener[$pos] = pop @delim_index; # map close index to open index
  1259. }
  1260. }
  1261. }
  1262. }
  1263. elsif ($c =~ /[`']/)
  1264. {
  1265. $in_quotes = !$in_quotes;
  1266. }
  1267. $nesting_key[$pos] = $nesting_level; # track nesting level at each column
  1268. $quoting_key[$pos] = $in_quotes; # track nesting level at each column
  1269. }
  1270. # STEP 0: If there's an unmatched back-quote before the end of the line,
  1271. # and we're not in col. 1, and it isn't just `id', wrap before the back-quote:
  1272. if (length($line) > $width and substr($line, 0, $width-1) =~ /(`$id[^'`]*$)/) #` Fix syntax highlighting for emacs
  1273. {
  1274. $name_pos = $-[0];
  1275. if ($name_pos != 0)
  1276. {
  1277. print "*********** PRINT DBG 6 width=$width indent=$indentation *********\n" if $pdbg;
  1278. print2 ($indentation, (substr($line, 0, $name_pos) . "\n"));
  1279. $line = substr($line, $name_pos);
  1280. $nesting_level = $nesting_key[$name_pos - 1];
  1281. $in_quotes = $quoting_key[$name_pos - 1];
  1282. next WRAPLOOP;
  1283. }
  1284. }
  1285. # STEP 1: If there's an incomplete paren pair on the current line:
  1286. if (@delims)
  1287. {
  1288. #
  1289. # STEP 1A: Find the first open paren on the line whose matching close paren doesn't fit:
  1290. #
  1291. $open_pos = $delim_index[0];
  1292. while (1)
  1293. {
  1294. $beforeit = substr($line, 0, $open_pos);
  1295. # STEP 1Ai: If it's immediately preceded by >::ident[::ident...]
  1296. # or foo.template bar
  1297. # or foo.bar(...).template baz
  1298. if (($beforeit =~ /[>)](\s*(::|\.|->)?\s*$id)+$/) and $-[0] != 0)
  1299. {
  1300. # STEP 1A1a: If the opening angle bracket matching the 1st char of the r.e. above is on
  1301. # this line, move back to that position and go to 1Ai
  1302. $open_pos = $-[0];
  1303. if ($delim_opener[$open_pos] != -1)
  1304. {
  1305. $open_pos = $delim_opener[$open_pos];
  1306. next;
  1307. }
  1308. # STEP 1A1b: Else move to the first char of the r.e. above and go on to 1B (this is
  1309. # already where $open_pos indicates)
  1310. }
  1311. last;
  1312. }
  1313. if ($first_unmatched_close < $open_pos)
  1314. {
  1315. print "******** PRINT DBG 6A width=$width indent=$indentation ******\n" if $pdbg;
  1316. print2 ($indentation, (substr($line, 0, $first_unmatched_close) . "\n"));
  1317. $line = substr($line, $first_unmatched_close);
  1318. $nesting_level = $nesting_key[$first_unmatched_close - 1];
  1319. $in_quotes = $quoting_key[$first_unmatched_close - 1];
  1320. next WRAPLOOP;
  1321. }
  1322. #
  1323. # STEP 1B: If we're on an open paren, and there's a comma earlier on the line at the same level,
  1324. # and the last such comma is not the first non-ws char on the line, wrap just before it
  1325. # and don't indent:
  1326. #
  1327. $c = substr($line, $open_pos, 1);
  1328. if (exists $open_delims{$c}) # if it's an open paren...
  1329. {
  1330. if ($in_quotes and scanback "$line")
  1331. {
  1332. # We've found the comma
  1333. if ($comma_wrap eq 'B' and $nesting_level > 0)
  1334. {
  1335. # Wrap just before $comma_pos:
  1336. print "******** PRINT DBG 7 width=$width indent=$indentation ******\n" if $pdbg;
  1337. print2 ($indentation, (substr($line, 0, $comma_pos) . "\n"));
  1338. $line = substr($line, $comma_pos);
  1339. $nesting_level = $nesting_key[$comma_pos - 1];
  1340. $in_quotes = $quoting_key[$comma_pos - 1];
  1341. }
  1342. else
  1343. {
  1344. # Wrap just after $comma_pos:
  1345. print "******** PRINT DBG 8 width=$width indent=$indentation ******\n" if $pdbg;
  1346. print2 ($indentation, (substr($line, 0, $comma_pos +1) . "\n"));
  1347. while (substr($line, $comma_pos + 1, 1) eq ' ')
  1348. {
  1349. $comma_pos++;
  1350. }
  1351. $line = substr($line, $comma_pos + 1);
  1352. $nesting_level = $nesting_key[$comma_pos];
  1353. $in_quotes = $quoting_key[$comma_pos];
  1354. }
  1355. next WRAPLOOP;
  1356. }
  1357. }
  1358. # STEP 1C: Else if it's an open paren:
  1359. # if $nesting_level is 0, wrap before the pattern
  1360. # if line begins at col. 1, wrap just after the open and indent the next line
  1361. $c = substr($line, $open_pos, 1);
  1362. if (exists $open_delims{$c}) # if it's an open paren...
  1363. {
  1364. print "*********** PRINT DBG 9 width=$width indent=$indentation *********\n" if $pdbg;
  1365. print2 ($indentation, (substr($line, 0, $open_pos + 1) . "\n"));
  1366. $width -= $tabsize;
  1367. $line = " " . substr($line, $open_pos + 1); # special case xtra leading indent
  1368. $nesting_level = $nesting_key[$open_pos];
  1369. $in_quotes = $quoting_key[$open_pos];
  1370. next WRAPLOOP;
  1371. }
  1372. else # It must be a close paren. Wrap just before it and unindent the next line:
  1373. {
  1374. print "*********** PRINT DBG 10 width=$width indent=$indentation *********\n" if $pdbg;
  1375. print2 ($indentation, (substr($line, 0, $open_pos) . "\n"));
  1376. $width += $tabsize;
  1377. $line = substr($line, $open_pos);
  1378. $nesting_level = $nesting_key[$open_pos - 1];
  1379. $in_quotes = $quoting_key[$open_pos - 1];
  1380. next WRAPLOOP;
  1381. }
  1382. }
  1383. elsif ($first_unmatched_close < $pos)
  1384. {
  1385. print "*********** PRINT DBG 10A width=$width indent=$indentation *********\n" if $pdbg;
  1386. print2 ($indentation, (substr($line, 0, $first_unmatched_close) . "\n"));
  1387. $line = substr($line, $first_unmatched_close);
  1388. $nesting_level = $nesting_key[$first_unmatched_close - 1];
  1389. $in_quotes = $quoting_key[$first_unmatched_close - 1];
  1390. next WRAPLOOP;
  1391. }
  1392. else
  1393. {
  1394. # STEP 2: If there is a comma at the current level of paren nesting AND
  1395. # we're not at a nesting level of 0:
  1396. $open_pos = $pos;
  1397. if (!$at_left and $in_quotes and scanback "$line")
  1398. {
  1399. if ($comma_wrap eq 'B' and $nesting_level > 0)
  1400. {
  1401. print "*********** PRINT DBG 11: width=$width indent=$indentation *********\n" if $pdbg;
  1402. print2 ($indentation, (substr($line, 0, $comma_pos) . "\n"));
  1403. $line = substr($line, $comma_pos);
  1404. $nesting_level = $nesting_key[$comma_pos - 1];
  1405. $in_quotes = $quoting_key[$comma_pos - 1];
  1406. }
  1407. else
  1408. {
  1409. print "*********** PRINT DBG 12: width=$width indent=$indentation *********\n" if $pdbg;
  1410. print2 ($indentation, (substr($line, 0, $comma_pos + 1) . "\n"));
  1411. while ($comma_pos < ($width - 1) and substr($line, $comma_pos + 1, 1) eq ' ')
  1412. {
  1413. $comma_pos++;
  1414. }
  1415. $line = substr($line, $comma_pos + 1);
  1416. $nesting_level = $nesting_key[$comma_pos];
  1417. $in_quotes = $quoting_key[$comma_pos];
  1418. }
  1419. }
  1420. else
  1421. {
  1422. # extra by LZ: if last part of line is "`identifier" we have an unbalanced
  1423. # nesting level, then break before the "`"
  1424. if (length($line) > $width )
  1425. {
  1426. $beforeit = substr($line, 0, $open_pos);
  1427. if ($line =~ /`$id/ or $line =~/`[+-=!*<>%^&|\/~]+/)
  1428. {
  1429. $name_pos = $-[0];
  1430. if ($name_pos != 0 and $name_pos < $width and
  1431. !(($beforeit =~ /`$id'/ or $beforeit =~ /`[+-=!*<>%^&|\/~]+'/)
  1432. and $+[0] < $width)) #'))) fix syntax highlighting for emacs
  1433. {
  1434. if (exists $close_delims{substr($line, 0, 1)}) # special case for leading close
  1435. {
  1436. print "*********** PRINT DBG 13: width=$width indent=$indentation *********\n" if $pdbg;
  1437. break_and_print_plain2 (($tab x ($indentation - 1)) .
  1438. substr($line, 0, $name_pos) . "\n");
  1439. }
  1440. else
  1441. {
  1442. print "*********** PRINT DBG 14: width=$width indent=$indentation *********\n" if $pdbg;
  1443. break_and_print_plain2 (($tab x $indentation) .
  1444. substr($line, 0, $name_pos) . "\n");
  1445. }
  1446. $line = substr($line, $name_pos);
  1447. $nesting_level = $nesting_key[$name_pos - 1];
  1448. $in_quotes = $quoting_key[$name_pos - 1];
  1449. next WRAPLOOP;
  1450. }
  1451. }
  1452. }
  1453. # STEP 3: Just break according to standard alrogithm
  1454. print "*********** PRINT DBG 15: width=$width indent=$indentation *********\n" if $pdbg;
  1455. $line = break_and_print_fragment ( $indentation, $width, $line);
  1456. return if $line eq "";
  1457. $nesting_level = $nesting_key[$broke_at];
  1458. $in_quotes = $quoting_key[$broke_at];
  1459. }
  1460. }
  1461. } # WRAPLOOP
  1462. }
  1463. #
  1464. # break entire line using "plain" rules:
  1465. # usage: break_and_print_plain line
  1466. #
  1467. sub break_and_print_plain {
  1468. my $line = shift(@_);
  1469. if ($output_width != 0)
  1470. {
  1471. return if ($line = break_and_print_fragment (0, $output_width, "$line")) eq "";
  1472. while (($line = break_and_print_fragment (1, $output_width - $tabsize, "$line")) ne "")
  1473. {}
  1474. }
  1475. else
  1476. {
  1477. $line =~ s/\s+\n/\n/g; # delete trailing space on a line
  1478. print "$line";
  1479. }
  1480. }
  1481. #
  1482. # Process line using "Plain" break algorithm up to first line break,
  1483. # return remainder of line for subsequent processing:
  1484. # usage: break_and_print_fragment indent line
  1485. #
  1486. # No matter what, don't break in the middle of a pathname...so as not
  1487. # to mess up tools that locate errors in files. If the line length has
  1488. # to exceed the /width setting, so be it in that case...
  1489. #
  1490. sub break_and_print_fragment {
  1491. my $indent = shift(@_);
  1492. my $width = shift(@_) - 1;
  1493. my $line = shift(@_);
  1494. $nl_pos = index($line, "\n");
  1495. if ($nl_pos == -1 or $nl_pos > $width)
  1496. {
  1497. if ($obj)
  1498. {
  1499. substr($line, $width - 1, 0) = "\n" if (length($line) > $width);
  1500. }
  1501. else
  1502. {
  1503. if (length($line) > $width)
  1504. {
  1505. if ($prefix ne "" and $line =~ /:\d+:\s/g and pos($line) > $width) # never break within pathname
  1506. {
  1507. substr($line, pos($line), 0) = "\n";
  1508. }
  1509. else
  1510. {
  1511. $pos = $width;
  1512. $theChar = substr($line, $pos, 1);
  1513. $theCharBefore = ($pos > 0) ? substr($line, $pos - 1, 1) : ' ';
  1514. $theCharAfter = substr($line, $pos + 1, 1);
  1515. while ( ($theChar !~ /[\n '`,:]/ and $pos > 0 and !($theChar =~ /\w/ and $theCharBefore !~ /\w/))
  1516. or ($theChar !~ /\s/ and $theCharBefore =~ /[:\/\\.]/)
  1517. or ($theChar eq ':' and $theCharAfter =~ /[\/\\.]/)
  1518. or ($theChar eq "'" and $theCharBefore !~ /\s/)
  1519. or ($theChar =~ /[A-Za-z]/ and $theCharBefore =~ /['"`]/)
  1520. )
  1521. {
  1522. $pos--;
  1523. $theCharAfter = $theChar;
  1524. $theChar = substr($line, $pos, 1);
  1525. $theCharBefore = ($pos > 0) ? substr($line, $pos - 1, 1) : ' ';
  1526. }
  1527. $pos-- if $pos > 0 and $theChar eq ':' and substr($line, $pos-1, 1) eq ':';
  1528. if ($pos == 0)
  1529. {
  1530. $pos += $width;
  1531. substr($line, $pos, 0) = "\n";
  1532. }
  1533. else
  1534. {
  1535. substr($line, $pos, $theChar eq ' ' ? 1 : 0) = "\n";
  1536. $pos += ($theChar eq ' ' ? 1 : 2);
  1537. }
  1538. }
  1539. }
  1540. }
  1541. }
  1542. $line =~ s/ +\n/\n/g; # delete trailing space on a line
  1543. $nl_pos = index($line, "\n");
  1544. if ($nl_pos == -1)
  1545. {
  1546. print2 ($indent, $line);
  1547. return "";
  1548. }
  1549. print2 ($indent, substr($line, 0, $nl_pos + 1));
  1550. $whats_left = substr($line, $nl_pos + 1);
  1551. $broke_at = $nl_pos - 1;
  1552. return "$whats_left";
  1553. }
  1554. sub println
  1555. {
  1556. if ($wrap_own_msgs)
  1557. {
  1558. break_and_println_plain shift(@_);
  1559. }
  1560. else
  1561. {
  1562. print shift(@_) . "\n";
  1563. }
  1564. }
  1565. #
  1566. # call break_and_print_plain/fragment, adjust leading comma
  1567. #
  1568. sub break_and_print_plain2 {
  1569. my $line = shift(@_);
  1570. $line =~ s/^(\s*) ,/$1,/; # Adjust leading comma
  1571. break_and_print_plain "$line";
  1572. }
  1573. #
  1574. # break_and_println_plain: Break with Plain rules, add a newline:
  1575. #
  1576. sub break_and_println_plain {
  1577. break_and_print_plain shift(@_);
  1578. print "\n";
  1579. }
  1580. #
  1581. # print2: prints a line
  1582. # If using the 'Dave" break algorithm:
  1583. # Rule 1: Omits two spaces of indentation if there's a leading comma
  1584. # Rule 2: Reduces indentation by one tab if there's a leading close "paren"
  1585. # (unless already at far left)
  1586. #
  1587. # usage: print2 (indentation,line)
  1588. #
  1589. sub print2
  1590. {
  1591. my $indent = shift(@_);
  1592. my $line = shift(@_);
  1593. my $prefix = "";
  1594. if ($break_algorithm eq 'D')
  1595. {
  1596. if ($indent > 0) # special case for leading close - unindent just this line
  1597. {
  1598. $prefix = "$tab" x
  1599. ((exists $close_delims{substr($line, 0, 1)} and $indent > 1) ? ($indent - 1) : $indent);
  1600. }
  1601. if (substr($line, 0, 1) eq "," and length($line) > 4) # if leading comma, omit two spaces
  1602. { # of indentation
  1603. substr($prefix, length($prefix) - 4, 4) = " ";
  1604. }
  1605. # back up one space for open quotes to make alignment pretty in /break:D mode
  1606. if (substr($line, 0, 1) eq "`" and length($prefix) > 0) # ?? (was '`')
  1607. {
  1608. substr($prefix, 0, 1) = "";
  1609. }
  1610. }
  1611. else
  1612. {
  1613. $prefix = "$tab" x $indent;
  1614. }
  1615. print "$prefix" . $line;
  1616. }
  1617. #
  1618. # Scan backwards from position $open_pos for a comma at the same paren nesting level that is
  1619. # not the first non-whitespace on the line.
  1620. # return true if found, with $comma_pos indicating the position of the detected comma.
  1621. #
  1622. sub scanback
  1623. {
  1624. my $line = shift(@_);
  1625. my $c = substr($line, $open_pos, 1);
  1626. $nest_level = 0;
  1627. for ($comma_pos = $open_pos - 1; $comma_pos > 0; $comma_pos--) # scan back for comma at same level
  1628. {
  1629. $c = substr($line, $comma_pos, 1);
  1630. if (exists $open_delims{$c})
  1631. { # bail if we come to an open before (working
  1632. last if $nest_level == 0; # to the left) its matching close
  1633. $nest_level--;
  1634. next;
  1635. }
  1636. elsif (exists $close_delims{$c})
  1637. {
  1638. $nest_level++;
  1639. next;
  1640. }
  1641. elsif ($c eq ',' and $nest_level == 0) # comma at same level?
  1642. {
  1643. for ($pos = $comma_pos - 1; $pos > 0; $pos--) # scan to start of line
  1644. {
  1645. if (substr($line, $pos, 1) !~ /\s/) # comma preceded by non-space?
  1646. {
  1647. return 1; # yes, so it is a valid comma
  1648. }
  1649. }
  1650. # It IS the first non-ws on the line.
  1651. last;
  1652. }
  1653. }
  1654. return 0;
  1655. }
  1656. sub lognative_header
  1657. {
  1658. open(LOGNATIVE, ">NativeLog.txt") or
  1659. die "STL Decryptor: Can't create NativeLog.txt. Bailing out.";
  1660. print LOGNATIVE "---------------------------------------------------------------------\n";
  1661. print LOGNATIVE "$STLFilt_ID\n";
  1662. print LOGNATIVE "---------------------------------------------------------------------\n";
  1663. print LOGNATIVE "Command line: '@save_args'\n";
  1664. print LOGNATIVE "banner = $banner\n";
  1665. print LOGNATIVE "break_algorithm = $break_algorithm\n";
  1666. print LOGNATIVE "comma_wrap = $comma_wrap\n";
  1667. print LOGNATIVE "close_wrap = $close_wrap\n";
  1668. print LOGNATIVE "output_width = $output_width\n";
  1669. print LOGNATIVE "tabsize = $tabsize\n";
  1670. print LOGNATIVE "advise_re_policy_opts = $advise_re_policy_opts\n";
  1671. print LOGNATIVE "reformat_linenumbers = $reformat_linenumbers\n";
  1672. print LOGNATIVE "wrap_own_msgs = $wrap_own_msgs\n";
  1673. print LOGNATIVE "header_policy = $header_policy\n";
  1674. print LOGNATIVE "with_policy = $with_policy\n";
  1675. print LOGNATIVE "headers_to_show = $headers_to_show\n";
  1676. print LOGNATIVE "candidate_policy = $candidate_policy\n";
  1677. print LOGNATIVE "pathname_policy = $pathname_policy\n";
  1678. print LOGNATIVE "show_backtraces = $show_backtraces\n";
  1679. print LOGNATIVE "---------------------------------------------------------------------\n";
  1680. print LOGNATIVE "Native input follows:\n";
  1681. print LOGNATIVE "---------------------------------------------------------------------\n\n";
  1682. }
  1683. sub showkey
  1684. {
  1685. my $width = shift (@_);
  1686. print ((" " x ($width - 1)) . "v\n");
  1687. print " 1 2 3 4 5 6 7 8 9\n";
  1688. print "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345\n";
  1689. }