Processor.pm 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623
  1. #
  2. # Software Index, Copyright 2010, Software Index Project Team
  3. # Link: http://swi.sourceforge.net
  4. #
  5. # This file is part of Software Index Tool.
  6. #
  7. # Software Index is free software: you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation, version 3 of the License.
  10. #
  11. # Software Index is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with Software Index. If not, see <http://www.gnu.org/licenses/>.
  18. #
  19. use strict;
  20. use Data::Dumper;
  21. use FileHandle;
  22. use IPC::Open3;
  23. use XML::Simple;
  24. use String::CRC::Cksum;
  25. #
  26. # Export section
  27. #
  28. require Exporter;
  29. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER);
  30. @ISA = qw(Exporter);
  31. @EXPORT = qw(swiProcess);
  32. @EXPORT_OK = qw();
  33. $VERSION = '1.0';
  34. $PREFERRED_PARSER = undef;
  35. #
  36. # Subroutine for troubleshooting purposes
  37. #
  38. use Internal::Output;
  39. #
  40. # Global variables
  41. #
  42. my @crctab = (
  43. 0x00000000, 0x04c11db7, 0x09823b6e, 0x0d4326d9, 0x130476dc, 0x17c56b6b,
  44. 0x1a864db2, 0x1e475005, 0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61,
  45. 0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd, 0x4c11db70, 0x48d0c6c7,
  46. 0x4593e01e, 0x4152fda9, 0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75,
  47. 0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011, 0x791d4014, 0x7ddc5da3,
  48. 0x709f7b7a, 0x745e66cd, 0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039,
  49. 0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5, 0xbe2b5b58, 0xbaea46ef,
  50. 0xb7a96036, 0xb3687d81, 0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d,
  51. 0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49, 0xc7361b4c, 0xc3f706fb,
  52. 0xceb42022, 0xca753d95, 0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1,
  53. 0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d, 0x34867077, 0x30476dc0,
  54. 0x3d044b19, 0x39c556ae, 0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072,
  55. 0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16, 0x018aeb13, 0x054bf6a4,
  56. 0x0808d07d, 0x0cc9cdca, 0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde,
  57. 0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02, 0x5e9f46bf, 0x5a5e5b08,
  58. 0x571d7dd1, 0x53dc6066, 0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba,
  59. 0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e, 0xbfa1b04b, 0xbb60adfc,
  60. 0xb6238b25, 0xb2e29692, 0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6,
  61. 0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a, 0xe0b41de7, 0xe4750050,
  62. 0xe9362689, 0xedf73b3e, 0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2,
  63. 0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686, 0xd5b88683, 0xd1799b34,
  64. 0xdc3abded, 0xd8fba05a, 0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637,
  65. 0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb, 0x4f040d56, 0x4bc510e1,
  66. 0x46863638, 0x42472b8f, 0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53,
  67. 0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47, 0x36194d42, 0x32d850f5,
  68. 0x3f9b762c, 0x3b5a6b9b, 0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff,
  69. 0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623, 0xf12f560e, 0xf5ee4bb9,
  70. 0xf8ad6d60, 0xfc6c70d7, 0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b,
  71. 0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f, 0xc423cd6a, 0xc0e2d0dd,
  72. 0xcda1f604, 0xc960ebb3, 0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7,
  73. 0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b, 0x9b3660c6, 0x9ff77d71,
  74. 0x92b45ba8, 0x9675461f, 0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3,
  75. 0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640, 0x4e8ee645, 0x4a4ffbf2,
  76. 0x470cdd2b, 0x43cdc09c, 0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8,
  77. 0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24, 0x119b4be9, 0x155a565e,
  78. 0x18197087, 0x1cd86d30, 0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec,
  79. 0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088, 0x2497d08d, 0x2056cd3a,
  80. 0x2d15ebe3, 0x29d4f654, 0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0,
  81. 0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c, 0xe3a1cbc1, 0xe760d676,
  82. 0xea23f0af, 0xeee2ed18, 0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4,
  83. 0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0, 0x9abc8bd5, 0x9e7d9662,
  84. 0x933eb0bb, 0x97ffad0c, 0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668,
  85. 0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4
  86. );
  87. #
  88. # Brackets/hooks '()' in regexp are not acceptable in declarations below
  89. # TODO: configure individually for every language
  90. #
  91. my $regexpCommentSingle = '//';
  92. my $regexpCommentMultiStart = '/\\*';
  93. my $regexpCommentMultiEnd = '\\*/';
  94. my $regexpCodeBlockStart = '{';
  95. my $regexpCodeBlockEnd = '}';
  96. my $regexpCodeKeyword = 'case|do|else|if|for|switch|while';
  97. my $regexpCodeStatements =
  98. '\s*[^;]*[;]\s*|\s*extern\s+["]{2}\s*|\s*protected\s*[:]\s*|\s*private\s*[:]\s*|\s*public\s*[:]\s*';
  99. my $regexpCodeFunctionIdentifier =
  100. '(([_a-zA-Z:~][_a-zA-Z0-9:~]*[:][:])*operator[^a-zA-Z0-9_][^(]*)|([_a-zA-Z:~][_a-zA-Z0-9:~]*)';
  101. my $regexpCodeFunctionModifier = '[_a-zA-Z0-9:*&><, \t\n]*\s+[*&]?[*&]?\s*';
  102. my $regexpCodeFunctionArguments = '\s*\([^;]+\s*';
  103. my $regexpCodeContainerIdentifier = '[_a-zA-Z][_a-zA-Z0-9]*';
  104. my $regexpCodeContainerModifier =
  105. '\s*class|\s*template\s*<[^;]+>\s*class|\s*namespace|\s*template\s*<[^;]+>\s*struct|\s*struct|\s*static\s+struct|\s*static\s+union|\s*static\s+class|\s*enum|\s*typedef|\s*typedef\s+struct|\s*typedef\s+enum|\s*union|\s*typedef\s+union';
  106. my $regexpCodeContainerArguments = '\s*[^;]*\s*';
  107. my $regexpCodeContainerDelimeter = '::';
  108. my $regexpCodeBlockStartIgnore =
  109. '=\s*|,\s*|\s*enum\s*|\s*union\s*|\s*struct\s*';
  110. my $regexpCodeStringBorder_Escape =
  111. '(([^\\\](\\\\\\\\)*\\\\)|^([\\\](\\\\\\\\)*))';
  112. my $regexpCodeStringBorder_Text = '["\']';
  113. my $regexpCodePreprocessorStart = '^[ \t]*#';
  114. my $regexpCodePreprocessorEnd = '[^\\\\]\s*$';
  115. my $regexpCodeMatch_ComplexityCyclomatic =
  116. '([^0-9A-Za-z_]((if)|(case)|(for)|(while))[^0-9A-Za-z_])|[&][&]|[|][|]|[?]"';
  117. my $regexpCodeGlobalFunctionName = '>>>GLOBAL<<<';
  118. #
  119. # Handler for dupindex tool
  120. #
  121. my $dupindexHandler = undef;
  122. my $dupindexIn = undef;
  123. my $dupindexOut = undef;
  124. my $dupindexErr = undef;
  125. #
  126. # Errors counter, this global variable incremented if some inconsistency detected
  127. #
  128. my $exitCode = 0;
  129. #
  130. # Enter point
  131. #
  132. sub swiProcess
  133. {
  134. my $returnCode = 0;
  135. my $config = shift();
  136. my $moduleId = shift();
  137. my $rootLocation = shift();
  138. my $swiGlobalDirectory =
  139. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:location"};
  140. my $swiGlobalReportLocation =
  141. $config->{"swi:report"}->{"swi:destination"} . "/"
  142. . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"}
  143. . ".$moduleId";
  144. my $swiGlobalModuleName =
  145. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:name"};
  146. my $swiGlobalInclude =
  147. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:files"}
  148. ->{"swi:include"};
  149. my $swiGlobalExclude =
  150. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:files"}
  151. ->{"swi:exclude"};
  152. my $swiGlobalReportName =
  153. $config->{"swi:info"}->{"swi:project"}->{"swi:name"};
  154. my $swiGlobalPreprocessorRules =
  155. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:preprocessor"}
  156. ->{"swi:rule"};
  157. my $swiGlobalScanerRules =
  158. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:scanner"}
  159. ->{"swi:rule"};
  160. my $swiGlobalDupfinderEnabled =
  161. $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:indexer:dup"}
  162. ->{"swi:enabled"};
  163. if ( $returnCode == 0 )
  164. {
  165. if ( $swiGlobalDirectory eq "" )
  166. {
  167. STATUS(
  168. "Wrong configuration: source directory should be specified!");
  169. $returnCode = -1;
  170. }
  171. }
  172. if ( $returnCode == 0 )
  173. {
  174. if ( $swiGlobalReportLocation eq "" )
  175. {
  176. STATUS(
  177. "Wrong configuiration: report location should be specified!");
  178. $returnCode = -2;
  179. }
  180. }
  181. if ( not defined($swiGlobalInclude) )
  182. {
  183. $swiGlobalInclude = '.*';
  184. }
  185. if ( $returnCode == 0 )
  186. {
  187. my $filesData = {};
  188. $dupindexHandler =
  189. open3( $dupindexIn, $dupindexOut, $dupindexErr,
  190. "$rootLocation/dupindex/bin/dupindex.exe" );
  191. if (!defined($dupindexHandler) || !defined($dupindexIn) || !defined($dupindexOut) )
  192. {
  193. die("Can not start the internal platform native tool '$rootLocation/dupindex/bin/dupindex.exe'");
  194. }
  195. my $dupfinderSettings =
  196. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  197. ->{"swi:indexer:dup"};
  198. if ( defined( $dupfinderSettings->{"swi:minlength"} ) )
  199. {
  200. print $dupindexIn "init_length\n";
  201. print $dupindexIn $dupfinderSettings->{"swi:minlength"} . "\n";
  202. }
  203. if ( defined( $dupfinderSettings->{"swi:proximity"} ) )
  204. {
  205. print $dupindexIn "init_proximity\n";
  206. print $dupindexIn $dupfinderSettings->{"swi:proximity"} . "\n";
  207. }
  208. # TODO: configure individually for every language
  209. # see for todos in dupindex.cpp file
  210. #print $dupindexIn "init_ignorable\n";
  211. #print $dupindexIn "\n";
  212. #print $dupindexIn "init_nonregular\n";
  213. #print $dupindexIn "\n";
  214. opendir( DIR, $swiGlobalDirectory )
  215. or die("Can not open source directory '$swiGlobalDirectory'!");
  216. while ( my $file = readdir(DIR) )
  217. {
  218. if ( $file =~ m/$swiGlobalInclude/ )
  219. {
  220. if ( $swiGlobalExclude ne ""
  221. && $file =~ m/$swiGlobalExclude/ )
  222. {
  223. next;
  224. }
  225. $filesData->{$file} = swiParse(
  226. $swiGlobalDirectory,
  227. $file,
  228. $swiGlobalPreprocessorRules,
  229. $swiGlobalScanerRules,
  230. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  231. ->{"swi:indexer:dup"},
  232. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  233. ->{"swi:indexer:gcov"}
  234. );
  235. }
  236. }
  237. closedir(DIR);
  238. # Add duplication statistics
  239. if ( defined($swiGlobalDupfinderEnabled)
  240. && $swiGlobalDupfinderEnabled eq 'on' )
  241. {
  242. $filesData = swiSourceIndexDuplicationAdd($filesData);
  243. }
  244. else
  245. {
  246. print $dupindexIn "exit\n";
  247. }
  248. # Prepare XML report
  249. STATUS("Generating the report '$swiGlobalReportLocation'...");
  250. swiXmlReportPrint(
  251. $filesData, $swiGlobalDirectory,
  252. $swiGlobalReportLocation, $swiGlobalModuleName
  253. );
  254. $returnCode = $exitCode;
  255. }
  256. return $returnCode;
  257. }
  258. sub swiXmlReportPrint()
  259. {
  260. my $filesData = shift();
  261. my $curDir = shift();
  262. my $reportLocation = shift();
  263. my $moduleName = shift();
  264. $curDir =~ s/\n$//;
  265. my $fh = new FileHandle( "$reportLocation", "w" )
  266. or die("Can not open output file: $reportLocation!");
  267. print $fh "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
  268. print $fh "<swi:report>\n";
  269. print $fh "\n";
  270. print $fh " <swi:module>\n";
  271. print $fh " <swi:name>" . $moduleName . "</swi:name>\n";
  272. print $fh " <swi:location>" . $curDir . "</swi:location>\n";
  273. print $fh "\n";
  274. print $fh " <swi:info>\n";
  275. print $fh " <swi:version>1</swi:version>\n";
  276. if ( defined( $ENV{USER} ) )
  277. {
  278. print $fh " <swi:user>" . $ENV{USER} . "</swi:user>\n";
  279. }
  280. print $fh " <swi:generator>SWI/PROCESSOR</swi:generator>\n";
  281. print $fh " </swi:info>\n";
  282. print $fh "\n";
  283. my $filesCount = 0;
  284. my $functionsCount = 0;
  285. foreach my $file ( keys %{$filesData} )
  286. {
  287. $filesCount++;
  288. print $fh " <swi:file>\n";
  289. print $fh " <swi:name>" . $file . "</swi:name>\n";
  290. print $fh " <swi:location>" . $file . "</swi:location>\n";
  291. print $fh "\n";
  292. my $functions = $filesData->{$file};
  293. my $localFunctionsCount = 0;
  294. foreach my $function ( keys %$functions )
  295. {
  296. $functionsCount++;
  297. $localFunctionsCount++;
  298. print $fh " <swi:function>\n";
  299. print $fh " " . XMLout( $function, RootName => 'swi:name' );
  300. print $fh " "
  301. . XMLout(
  302. $file . ":"
  303. . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ),
  304. RootName => 'swi:location'
  305. );
  306. print $fh " "
  307. . XMLout( $functions->{$function}->{'swi:modifier'},
  308. RootName => 'swi:modifier' );
  309. print $fh " <swi:pointer"
  310. . " swi:headerstart=\""
  311. . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ) . "\""
  312. . " swi:commentstart=\""
  313. . ( $functions->{$function}->{'swi:line:commentstart'} + 1 )
  314. . "\""
  315. . " swi:blockstart=\""
  316. . ( $functions->{$function}->{'swi:line:blockstart'} + 1 ) . "\""
  317. . " swi:blockend=\""
  318. . ( $functions->{$function}->{'swi:line:blockend'} + 1 ) . "\""
  319. . " />\n";
  320. my $statStr = XMLout(
  321. $functions->{$function}->{'swi:statistic'},
  322. RootName => 'swi:statistic',
  323. GroupTags => {
  324. 'swi:complexity' => '__REMOVE__',
  325. 'swi:duplication' => '__REMOVE__',
  326. 'swi:length' => '__REMOVE__',
  327. 'swi:lines' => '__REMOVE__',
  328. 'swi:checksum' => '__REMOVE__'
  329. }
  330. );
  331. $statStr =~ s/\n/\n /g;
  332. $statStr =~ s/ name="__REMOVE__"//g;
  333. print $fh " ";
  334. print $fh $statStr;
  335. print $fh "\n";
  336. my $refStr = XMLout( $functions->{$function}->{'swi:reference'},
  337. RootName => '' );
  338. $refStr =~ s/\n/\n /g;
  339. $refStr =~ s/<anon /<swi:reference /g;
  340. print $fh " ";
  341. print $fh $refStr;
  342. print $fh " </swi:function>\n";
  343. print $fh "\n";
  344. }
  345. print $fh " <swi:statistic>\n";
  346. print $fh " <swi:count>\n";
  347. print $fh " <swi:functions swi:exact=\""
  348. . $localFunctionsCount
  349. . "\" />\n";
  350. print $fh " </swi:count>\n";
  351. print $fh " </swi:statistic>\n";
  352. print $fh "\n";
  353. print $fh " </swi:file>\n";
  354. print $fh "\n";
  355. }
  356. print $fh " <swi:statistic>\n";
  357. print $fh " <swi:count>\n";
  358. # Warning: swi_merger requires to have counter of files before counters of functions
  359. print $fh " <swi:files swi:exact=\"" . $filesCount . "\" />\n";
  360. print $fh " <swi:functions swi:exact=\""
  361. . $functionsCount
  362. . "\" />\n";
  363. print $fh " </swi:count>\n";
  364. print $fh " </swi:statistic>\n";
  365. print $fh "\n";
  366. print $fh " </swi:module>\n";
  367. print $fh "\n";
  368. print $fh "</swi:report>\n";
  369. $fh->close();
  370. }
  371. #
  372. # Parser enter point
  373. #
  374. sub swiParse
  375. {
  376. my $location = shift();
  377. my $file = shift();
  378. my $preprocessorRules = shift();
  379. my $scanerRules = shift();
  380. my $dupfinderSettings = shift();
  381. my $gcovSettings = shift();
  382. STATUS("Parsing file: '$location/$file'.");
  383. my $fh = new FileHandle( $location . "/" . $file, "r" )
  384. or die("Can not open input file '$location/$file'!");
  385. my @fileLines = <$fh>;
  386. # Get all types of strings
  387. my ( $globalBlock_Initial, $globalBlock_Code, $globalBlock_Comment ) =
  388. swiSourceCommentsDeattach(@fileLines);
  389. my $globalBlock_NoStr = swiSourceCodeStringsRemove($globalBlock_Code);
  390. my $globalBlock_NoPrep = swiSourceCodePreprocessorRemove($globalBlock_Code);
  391. my $globalBlock_Purified = swiSourceCodeStringsRemove($globalBlock_NoPrep);
  392. # Preprocess purified code
  393. foreach my $rule ( @{$preprocessorRules} )
  394. {
  395. my $pattern = $rule->{'swi:filepattern'};
  396. if ( $file =~ m/$pattern/ )
  397. {
  398. $globalBlock_Purified = swiSourceCodePreprocess(
  399. $globalBlock_Purified,
  400. $rule->{'swi:searchpattern'},
  401. $rule->{'swi:replacepattern'}
  402. );
  403. }
  404. }
  405. # Parse source code
  406. my $functionsData =
  407. swiSourceCodeParse( $file, $globalBlock_Purified, $globalBlock_Comment );
  408. # Adjusting scaner rules (for performance purposes)
  409. my $scanerRulesFiltered = [];
  410. foreach my $rule ( @{$scanerRules} )
  411. {
  412. my $pattern = $rule->{'swi:filepattern'};
  413. if ( $file =~ m/$pattern/ )
  414. {
  415. push( @{$scanerRulesFiltered}, $rule );
  416. }
  417. }
  418. # Add statistics
  419. $functionsData = swiSourceIndexAdd(
  420. $file, $functionsData, $scanerRulesFiltered,
  421. $dupfinderSettings, $globalBlock_Initial, $globalBlock_Code,
  422. $globalBlock_Comment, $globalBlock_NoPrep, $globalBlock_NoStr,
  423. $globalBlock_Purified
  424. );
  425. if ( $gcovSettings->{'swi:enabled'} eq 'on' )
  426. {
  427. my $filePattern = $gcovSettings->{'swi:filepattern'};
  428. if ( $file =~ m/$filePattern/ )
  429. {
  430. swiSourceIndexGcovAdd(
  431. $location, $file, $functionsData,
  432. $gcovSettings->{'swi:sourcefile'},
  433. $gcovSettings->{'swi:gcdafile'}
  434. );
  435. }
  436. }
  437. return $functionsData;
  438. }
  439. sub swiSourceCodePreprocess
  440. {
  441. my $code = shift();
  442. my $search = shift();
  443. my $replace = shift();
  444. my $lastPart = $code;
  445. my $result = "";
  446. my $posPrev = 0;
  447. my $posCurrent = 0;
  448. while ( $code =~ m/$search/g )
  449. {
  450. $posPrev = $posCurrent;
  451. $posCurrent = pos($code);
  452. my $matchStr = $&;
  453. $lastPart = $';
  454. my $replaceString = eval( 'my $tmp = "' . $replace . '";' );
  455. if ( swiMatchPatternCount( $matchStr, '\n' ) !=
  456. swiMatchPatternCount( $replaceString, '\n' ) )
  457. {
  458. die(
  459. "Wrong preprocessor rule detected in the configuration file: it changes number of lines replacing the text\n>>>\n"
  460. . $matchStr
  461. . "\n<<<\nby\n>>>\n"
  462. . $replaceString
  463. . "\n<<<\n" );
  464. }
  465. my $blockFrag =
  466. substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );
  467. $result .= ( $blockFrag . $replaceString );
  468. }
  469. $result .= $lastPart;
  470. return $result;
  471. }
  472. sub swiSourceCodeScan
  473. {
  474. my $file = shift();
  475. my $offset = shift();
  476. my $code = shift();
  477. my $search = shift();
  478. my $message = shift();
  479. my @result = [];
  480. while ( $code =~ m/$search/g )
  481. {
  482. my $matchPre = $`;
  483. my $matchStr = $&;
  484. my $linePos = swiMatchPatternCount( $matchPre . $matchStr, '\n' ) + 1;
  485. my $messageString = eval( 'my $tmp = "' . $message . '";' );
  486. push(
  487. @result,
  488. {
  489. 'swi:ref:type' => 'scan',
  490. 'swi:scan:file' => $file,
  491. 'swi:scan:line' => $linePos + $offset,
  492. 'swi:scan:message' => $messageString
  493. }
  494. );
  495. }
  496. return @result;
  497. }
  498. sub swiSourceCodeGlobalGet
  499. {
  500. my $functionsData = shift();
  501. my $endLine = shift();
  502. my @blockCodeAgr = @_;
  503. my @blockCode;
  504. if ( $#blockCodeAgr == 0 )
  505. {
  506. # Continues code string provided
  507. @blockCode = split( "\n", $blockCodeAgr[0] );
  508. }
  509. else
  510. {
  511. # Array of lines provided
  512. @blockCode = @blockCodeAgr;
  513. }
  514. if ( !defined($endLine) )
  515. {
  516. $endLine = $#blockCode + 100; # Just with overhead
  517. }
  518. foreach my $function ( values %{$functionsData} )
  519. {
  520. for (
  521. my $i = $function->{'swi:line:commentstart'} ;
  522. $i <= $function->{'swi:line:blockend'} ;
  523. $i++
  524. )
  525. {
  526. # Clear line if it is inside function
  527. $blockCode[$i] = "";
  528. }
  529. }
  530. my $result = "";
  531. foreach (@blockCode)
  532. {
  533. $endLine--;
  534. if ( $endLine < 0 )
  535. {
  536. last;
  537. }
  538. $result .= $_ . "\n";
  539. }
  540. return $result;
  541. }
  542. sub swiDupindexFunctionAdd
  543. {
  544. my $fileName = shift();
  545. my $functionName = shift();
  546. my $functionCode = shift();
  547. print $dupindexIn "init_file\n";
  548. print $dupindexIn length($fileName) . "\n";
  549. print $dupindexIn length($functionName) . "\n";
  550. print $dupindexIn length($functionCode) . "\n";
  551. print $dupindexIn $fileName . $functionName . $functionCode . "\n";
  552. }
  553. sub swiSourceIndexAdd
  554. {
  555. my $file = shift();
  556. my $functionsData = shift();
  557. my $scanerRules = shift();
  558. my $dupfinderSettings = shift();
  559. my @block_Initial = split( "\n", shift() );
  560. my @block_Code = split( "\n", shift() );
  561. my @block_Comment = split( "\n", shift() );
  562. my @block_NoPrep = split( "\n", shift() );
  563. my @block_NoStr = split( "\n", shift() );
  564. my $block_Purified = shift();
  565. # Extend arrays in order to remove warnings
  566. my $finalLinesNum = swiMatchPatternCount( $block_Purified, '\n' ) + 1;
  567. @block_Initial = swiUtilArrayExtend( [@block_Initial], $finalLinesNum, "" );
  568. @block_Code = swiUtilArrayExtend( [@block_Code], $finalLinesNum, "" );
  569. @block_Comment = swiUtilArrayExtend( [@block_Comment], $finalLinesNum, "" );
  570. @block_NoPrep = swiUtilArrayExtend( [@block_NoPrep], $finalLinesNum, "" );
  571. @block_NoStr = swiUtilArrayExtend( [@block_NoStr], $finalLinesNum, "" );
  572. foreach my $functionName ( keys %{$functionsData} )
  573. {
  574. my $function = $functionsData->{$functionName};
  575. my $block = {};
  576. $block->{'functionname'} = $functionName;
  577. $block->{'functionname'} =~
  578. s/($regexpCodeContainerDelimeter)?($regexpCodeContainerIdentifier$regexpCodeContainerDelimeter)*($regexpCodeFunctionIdentifier)/$3/;
  579. if ( $functionName ne $regexpCodeGlobalFunctionName )
  580. {
  581. # Get content
  582. $block->{'initial'} = "";
  583. for (
  584. my $i = $function->{'swi:line:commentstart'} ;
  585. $i <= $function->{'swi:line:blockend'} ;
  586. $i++
  587. )
  588. {
  589. $block->{'initial'} .= $block_Initial[$i] . "\n";
  590. }
  591. $block->{'code'} = "";
  592. for (
  593. my $i = $function->{'swi:line:commentstart'} ;
  594. $i <= $function->{'swi:line:blockend'} ;
  595. $i++
  596. )
  597. {
  598. $block->{'code'} .= $block_Code[$i] . "\n";
  599. }
  600. $block->{'comments'} = "";
  601. for (
  602. my $i = $function->{'swi:line:commentstart'} ;
  603. $i <= $function->{'swi:line:blockend'} ;
  604. $i++
  605. )
  606. {
  607. $block->{'comments'} .= $block_Comment[$i] . "\n";
  608. }
  609. $block->{'nopreprocessor'} = "";
  610. for (
  611. my $i = $function->{'swi:line:commentstart'} ;
  612. $i <= $function->{'swi:line:blockend'} ;
  613. $i++
  614. )
  615. {
  616. $block->{'nopreprocessor'} .= $block_NoPrep[$i] . "\n";
  617. }
  618. $block->{'nostrings'} = "";
  619. for (
  620. my $i = $function->{'swi:line:commentstart'} ;
  621. $i <= $function->{'swi:line:blockend'} ;
  622. $i++
  623. )
  624. {
  625. $block->{'nostrings'} .= $block_NoStr[$i] . "\n";
  626. }
  627. $block->{'purified'} = substr(
  628. $block_Purified,
  629. $function->{'swi:pos:headerstart'},
  630. $function->{'swi:pos:blockend'} -
  631. $function->{'swi:pos:headerstart'}
  632. )
  633. . "\n";
  634. $block->{'commentshead'} = "";
  635. for (
  636. my $i = $function->{'swi:line:commentstart'} ;
  637. $i < $function->{'swi:line:headerstart'} ;
  638. $i++
  639. )
  640. {
  641. $block->{'commentshead'} .= $block_Comment[$i] . "\n";
  642. }
  643. # functionname created above
  644. $block->{'functionhead'} = substr(
  645. $block_Purified,
  646. $function->{'swi:pos:headerstart'},
  647. $function->{'swi:pos:blockstart'} -
  648. $function->{'swi:pos:headerstart'}
  649. )
  650. . "\n";
  651. $block->{'functionbody'} = substr(
  652. $block_Purified,
  653. $function->{'swi:pos:blockstart'},
  654. $function->{'swi:pos:blockend'} -
  655. $function->{'swi:pos:blockstart'}
  656. )
  657. . "\n";
  658. }
  659. else
  660. {
  661. $block->{'initial'} =
  662. swiSourceCodeGlobalGet( $functionsData, undef, @block_Initial );
  663. $block->{'code'} =
  664. swiSourceCodeGlobalGet( $functionsData, undef, @block_Code );
  665. $block->{'comments'} =
  666. swiSourceCodeGlobalGet( $functionsData, undef, @block_Comment );
  667. $block->{'nopreprocessor'} =
  668. swiSourceCodeGlobalGet( $functionsData, undef, @block_NoPrep );
  669. $block->{'nostrings'} =
  670. swiSourceCodeGlobalGet( $functionsData, undef, @block_NoStr );
  671. $block->{'purified'} =
  672. swiSourceCodeGlobalGet( $functionsData, undef, $block_Purified );
  673. $block->{'commentshead'} =
  674. swiSourceCodeGlobalGet( $functionsData,
  675. $function->{'swi:line:headerstart'},
  676. @block_Comment );
  677. }
  678. # Initialize container
  679. $function->{'swi:statistic'} = {
  680. 'swi:length' => {
  681. 'swi:source' => {},
  682. 'swi:executable' => {},
  683. 'swi:comment' => {},
  684. 'swi:blank' => {},
  685. 'swi:function:name' => {}
  686. },
  687. 'swi:lines' => {
  688. 'swi:source' => {},
  689. 'swi:executable' => {},
  690. 'swi:comment' => {},
  691. 'swi:blank' => {},
  692. 'swi:comment:header' => {}
  693. },
  694. 'swi:complexity' => {
  695. 'swi:cyclomatic' => {},
  696. 'swi:blocks' => {},
  697. 'swi:maxdepth' => {}
  698. },
  699. 'swi:duplication' => { 'swi:symbols' => { 'swi:exact' => 0 }, },
  700. 'swi:checksum' => { 'swi:source' => { 'swi:exact' => 0 }, }
  701. };
  702. $function->{'swi:reference'} = [];
  703. # Calculate swi:length->swi:source
  704. # Note: this statistic is used to detect differences
  705. # Global code is compared without new lines
  706. my $initialContent = $block->{'initial'};
  707. if ($functionName eq $regexpCodeGlobalFunctionName)
  708. {
  709. $initialContent =~ s/\n+//g;
  710. }
  711. $function->{'swi:statistic'}->{'swi:length'}->{'swi:source'}
  712. ->{'swi:exact'} = length( $initialContent );
  713. # Calculate swi:length->swi:executable
  714. $function->{'swi:statistic'}->{'swi:length'}->{'swi:executable'}
  715. ->{'swi:exact'} = length( $block->{'purified'} );
  716. # Calculate swi:length->swi:comment
  717. $function->{'swi:statistic'}->{'swi:length'}->{'swi:comment'}
  718. ->{'swi:exact'} = length( $block->{'comments'} );
  719. # Calculate swi:length->swi:blank
  720. $function->{'swi:statistic'}->{'swi:length'}->{'swi:blank'}
  721. ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\s' );
  722. # Calculate swi:length->swi:function-name
  723. $function->{'swi:statistic'}->{'swi:length'}->{'swi:function:name'}
  724. ->{'swi:exact'} = length( $block->{'functionname'} );
  725. # Calculate swi:lines->swi:source
  726. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:source'}
  727. ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\n' );
  728. # Calculate swi:lines->swi:executable
  729. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:executable'}
  730. ->{'swi:exact'} =
  731. swiMatchLinesCount( $block->{'purified'}, '[^ \t]' );
  732. # Calculate swi:lines->swi:comment
  733. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment'}
  734. ->{'swi:exact'} =
  735. swiMatchLinesCount( $block->{'comments'}, '[^ \t]' );
  736. # Calculate swi:lines->swi:blank
  737. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:blank'}
  738. ->{'swi:exact'} = swiMatchLinesCount( $block->{'initial'}, '^\s*$' );
  739. # Calculate swi:lines->swi:comment:header
  740. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment:header'}
  741. ->{'swi:exact'} =
  742. $function->{'swi:line:headerstart'} -
  743. $function->{'swi:line:commentstart'};
  744. # Calculate swi:complexity->swi:cyclomatic
  745. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:cyclomatic'}
  746. ->{'swi:exact'} =
  747. swiMatchPatternCount(
  748. swiSourceCodeStringsRemove( $block->{'purified'} ),
  749. $regexpCodeMatch_ComplexityCyclomatic );
  750. # Calculate swi:complexity->swi:blocks
  751. # -1 in order not to count main function's block
  752. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:blocks'}
  753. ->{'swi:exact'} =
  754. swiMatchPatternCount( $block->{'purified'}, $regexpCodeBlockStart ) -
  755. 1;
  756. # Calculate swi:complexity->swi:maxdepth
  757. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:maxdepth'}
  758. ->{'swi:exact'} = $function->{'swi:depth'};
  759. # Calculate swi:checksum->swi:index
  760. # Note: this statistic is used to detect differences
  761. # Global code is compared without new lines
  762. my @symbols = split( //, $initialContent );
  763. my $crcSumTotal = 0;
  764. for ( my $pos = 0 ; $pos <= $#symbols ; $pos++ )
  765. {
  766. $crcSumTotal =
  767. ( $crcSumTotal << 8 )
  768. ^ $crctab[ ( $crcSumTotal >> 24 ) ^ ( unpack 'C', $symbols[$pos] )
  769. ];
  770. }
  771. $function->{'swi:statistic'}->{'swi:checksum'}->{'swi:source'}
  772. ->{'swi:exact'} = $crcSumTotal;
  773. # Scan function by scaner tool
  774. foreach my $rule ( @{$scanerRules} )
  775. {
  776. if ( defined( $block->{ $rule->{'swi:codecontent'} } ) )
  777. {
  778. push(
  779. @{ $function->{'swi:reference'} },
  780. swiSourceCodeScan(
  781. $file,
  782. $function->{'swi:line:headerstart'},
  783. $block->{ $rule->{'swi:codecontent'} },
  784. $rule->{'swi:searchpattern'},
  785. $rule->{'swi:messagepattern'}
  786. )
  787. );
  788. }
  789. else
  790. {
  791. STATUS(
  792. "Wrong configuiration: 'swi:scaner/swi:rule/swi:codecontent' property is not from the acceptable set of values!"
  793. );
  794. $exitCode++;
  795. }
  796. }
  797. # Add to dupindexer for further processing
  798. if ( defined( $block->{ $dupfinderSettings->{'swi:codecontent'} } ) )
  799. {
  800. if (
  801. $functionName ne $regexpCodeGlobalFunctionName
  802. || ( defined( $dupfinderSettings->{'swi:globalcode'} )
  803. && $dupfinderSettings->{'swi:globalcode'} eq 'on' )
  804. )
  805. {
  806. swiDupindexFunctionAdd( $file, $functionName,
  807. $block->{ $dupfinderSettings->{'swi:codecontent'} } );
  808. }
  809. }
  810. else
  811. {
  812. STATUS(
  813. "Wrong configuiration: 'swi:indexer:dup/swi:codecontent' property is not from the acceptable set of values!"
  814. );
  815. $exitCode++;
  816. }
  817. }
  818. return $functionsData;
  819. }
  820. #
  821. # This function uses external tool for duplication collection
  822. #
  823. sub swiSourceIndexDuplicationAdd
  824. {
  825. my $filesData = shift();
  826. STATUS("Searching for duplication...");
  827. print $dupindexIn "start\n";
  828. my $outStream = "";
  829. while ( defined($dupindexOut) && ( my $line = <$dupindexOut> ) )
  830. {
  831. $outStream .= $line;
  832. }
  833. my @dupdataGoups = split( /info: group_start/, $outStream );
  834. foreach (@dupdataGoups)
  835. {
  836. my @parsedData;
  837. my @dupdataSplit = split( /\n/, $_ );
  838. foreach (@dupdataSplit)
  839. {
  840. if ( $_ =~
  841. m/duplication: file: '(.*)' function: '(.*)' possition: '(.*)' size: '(.*)'/
  842. )
  843. {
  844. $filesData->{$1}->{$2}->{'swi:statistic'}->{'swi:duplication'}
  845. ->{'swi:symbols'}->{'swi:exact'} += $4;
  846. push(
  847. @parsedData,
  848. {
  849. 'swi:ref:type' => 'dup',
  850. 'swi:dup:file' => $1,
  851. 'swi:dup:function' => $2,
  852. 'swi:dup:line' => $3 +
  853. $filesData->{$1}->{$2}->{'swi:line:headerstart'},
  854. 'swi:dup:size' => $4
  855. }
  856. );
  857. }
  858. }
  859. foreach my $dupData (@parsedData)
  860. {
  861. push(
  862. @{
  863. $filesData->{ $dupData->{'swi:dup:file'} }
  864. ->{ $dupData->{'swi:dup:function'} }->{'swi:reference'}
  865. },
  866. @parsedData
  867. );
  868. }
  869. }
  870. my $errStream = "";
  871. while ( defined($dupindexErr) && ( my $line = <$dupindexErr> ) )
  872. {
  873. STATUS("Internal dupindex tool detected the error.");
  874. STATUS($line);
  875. STATUS(" 1. Check 'swi:indexer:dup' section in configuration.");
  876. STATUS(
  877. " 2. Check that swi/dupindex tool is runable on your system/platform."
  878. );
  879. STATUS(" 3. Recompile swi/dupindex tool for your system/platform.");
  880. STATUS(" 4. Report the problem to developers.");
  881. # The final return code is unsuccessful
  882. # It means that these errors/warnings should be fixed before the next processing
  883. $exitCode++;
  884. }
  885. return $filesData;
  886. }
  887. sub swiSourceIndexGcovAdd
  888. {
  889. my $location = shift();
  890. my $file = shift();
  891. my $functionsData = shift();
  892. my $filePattern = shift();
  893. my @listTmp = $file =~ m/$filePattern/;
  894. my $gcdaFile = eval( 'my $tmp = "' . shift() . '";' );
  895. # Add coverage statistic
  896. my $fh = new FileHandle( $location . "/" . $gcdaFile, "r" );
  897. if ( !defined($fh) )
  898. {
  899. STATUS("gcda file is not found '$location/$gcdaFile'.");
  900. }
  901. else
  902. {
  903. my $gcovCommand = 'gcov -f -b $location/$gcdaFile';
  904. STATUS("Calling command '$gcovCommand'...");
  905. my $gcovData = `$gcovCommand`;
  906. my @covData = split( "\n\n", $gcovData );
  907. foreach (@covData)
  908. {
  909. next if ( $_ =~ m/^File/ );
  910. my (
  911. $functionName, $linesExec, $linesTotal, $branchesExec,
  912. $branchesTotal, $takenOnce, $callsExec, $callsTotal
  913. )
  914. = ( $_ =~
  915. m/^Function\s+\'(.*)\'\s+Lines\s+executed:(.*)%\s+of\s+(.*)\s+Branches\s+executed:(.*)%\s+of\s+(.*)\s+Taken\s+at\s+least\s+once:(.*)%\s+of\s+.*\s+Calls\s+executed:(.*)%\s+of\s+(.*)/
  916. );
  917. if ( defined( $functionsData->{$functionName} ) )
  918. {
  919. $functionsData->{$functionName}->{'swi:statistic'}
  920. ->{'swi:coverage'} = {
  921. 'swi:gsum:lines' => { 'swi:exact' => $linesTotal },
  922. 'swi:gsum:branches' => { 'swi:exact' => $branchesTotal },
  923. 'swi:gsum:calls' => { 'swi:exact' => $callsTotal },
  924. 'swi:gcov:lines' => {
  925. 'swi:exact' =>
  926. swiUtil_Round( $linesExec * $linesTotal / 100 )
  927. },
  928. 'swi:gcov:branches' => {
  929. 'swi:exact' =>
  930. swiUtil_Round( $branchesExec * $branchesTotal / 100 )
  931. },
  932. 'swi:gcov:takenonce' => {
  933. 'swi:exact' =>
  934. swiUtil_Round( $takenOnce * $branchesTotal / 100 )
  935. },
  936. 'swi:gcov:calls' => {
  937. 'swi:exact' =>
  938. swiUtil_Round( $callsExec * $callsTotal / 100 )
  939. }
  940. };
  941. }
  942. else
  943. {
  944. STATUS(
  945. "Parsing of source file is incorrect or gcda file is corrupted."
  946. );
  947. STATUS(
  948. "gcov reports the data for '$functionName' function but SWI parser did not detect it"
  949. );
  950. $exitCode++;
  951. }
  952. }
  953. }
  954. }
  955. sub swiSourceCodeParse
  956. {
  957. my $file = shift();
  958. my $blockCode = shift();
  959. my @blockComment = split( "\n", shift() );
  960. @blockComment =
  961. swiUtilArrayExtend( [@blockComment],
  962. swiMatchPatternCount( $blockCode, '\n' ) + 1, "" );
  963. my $result = {};
  964. my $deepLevel = 0;
  965. if ( swiMatchPatternCount( $blockCode, $regexpCodeBlockStart ) !=
  966. swiMatchPatternCount( $blockCode, $regexpCodeBlockEnd ) )
  967. {
  968. PRINT( $file, 0, "error",
  969. "Mismatch in number of start/end of blocks delimeters!\n" );
  970. DEBUG("The code before parsing:\n$blockCode");
  971. return $result;
  972. }
  973. my $posPrev = 0;
  974. my $posCurrent = 0;
  975. my $isInFunction = 0;
  976. my $currentFunc = undef;
  977. my $currentLine = 0;
  978. my $currentPos = 0;
  979. my $currentDepth = 0;
  980. my @containers;
  981. while ( $blockCode =~ m/($regexpCodeBlockStart)|($regexpCodeBlockEnd)/g )
  982. {
  983. $posPrev = $posCurrent;
  984. $posCurrent = pos($blockCode);
  985. my $matchPre = $`;
  986. my $matchStr = $&;
  987. my $matchPost = $';
  988. my $blockFragFull =
  989. substr( $blockCode, $posPrev, $posCurrent - $posPrev );
  990. $currentLine += swiMatchPatternCount( $blockFragFull, "\n" );
  991. $currentPos += length($blockFragFull);
  992. if ( $matchStr =~ m/^$regexpCodeBlockStart$/ )
  993. {
  994. my $blockFragLast = $blockFragFull;
  995. $blockFragLast =~ s/^($regexpCodeStatements)*\s*//;
  996. # opened block detected
  997. $deepLevel++;
  998. if ( $isInFunction == 0 )
  999. {
  1000. # Check whether it is a function start
  1001. if ( $blockFragLast =~
  1002. m/^($regexpCodeFunctionModifier)*($regexpCodeFunctionIdentifier)($regexpCodeFunctionArguments)($regexpCodeBlockStart)$/
  1003. )
  1004. {
  1005. my $matchedHeader = $&;
  1006. my $mod = $1;
  1007. my $word = $2;
  1008. if ( !defined($mod) )
  1009. {
  1010. $mod = "";
  1011. }
  1012. # Remove empty symbols in header
  1013. $matchedHeader =~ s/^\s*//;
  1014. # Check if modifier consumes something from identifier
  1015. # and return back the last part from modifier to identifier
  1016. ( $mod . $word ) =~ m/$regexpCodeFunctionIdentifier$/;
  1017. $mod = $`;
  1018. $word = $&;
  1019. # Remove empty symbols in identifier
  1020. $word =~ s/\s+$//;
  1021. $word =~ s/[\n\t ]+/ /g;
  1022. $word =~ s/\s*$regexpCodeContainerDelimeter\s*/$regexpCodeContainerDelimeter/;
  1023. # Remove empty symbols in modifier
  1024. $mod =~ s/^\s*//;
  1025. $mod =~ s/\s*$//;
  1026. $mod =~ s/[\n\t ]+/ /g;
  1027. if ( $word !~ m/^($regexpCodeKeyword)$/ )
  1028. {
  1029. $isInFunction = $deepLevel;
  1030. # Attach containers to the name of function
  1031. foreach my $container ( reverse @containers )
  1032. {
  1033. if ( defined($container) )
  1034. {
  1035. $word = $container
  1036. . $regexpCodeContainerDelimeter
  1037. . $word;
  1038. }
  1039. }
  1040. # Add the code before the block start
  1041. # (name of function, arguments, ..)
  1042. my $matchedHeaderLinesNum =
  1043. swiMatchPatternCount( $matchedHeader, "\n" );
  1044. # Check if there are comments before the header
  1045. my $consumedTopLines = 1;
  1046. while (
  1047. $currentLine - $matchedHeaderLinesNum -
  1048. $consumedTopLines >= 0
  1049. && $blockComment[
  1050. $currentLine - $matchedHeaderLinesNum -
  1051. $consumedTopLines
  1052. ] !~ m/^\s*$/
  1053. )
  1054. {
  1055. $consumedTopLines++;
  1056. }
  1057. if ( defined( $result->{$word} ) )
  1058. {
  1059. PRINT( $file, $currentLine + 1, 'debug',
  1060. "The same function detected more than once: '$word'"
  1061. );
  1062. my $counter = 2;
  1063. while (
  1064. defined(
  1065. $result->{ $word . " (" . $counter . ")" }
  1066. )
  1067. )
  1068. {
  1069. $counter++;
  1070. }
  1071. $word .= " (" . $counter . ")";
  1072. }
  1073. # Store data in result
  1074. $currentFunc = $word;
  1075. $result->{$word} = {
  1076. 'swi:pos:blockstart' => $currentPos,
  1077. 'swi:pos:headerstart' => $currentPos -
  1078. length($matchedHeader),
  1079. 'swi:pos:blockend' => undef,
  1080. 'swi:line:blockstart' => $currentLine,
  1081. 'swi:line:headerstart' => $currentLine -
  1082. $matchedHeaderLinesNum,
  1083. 'swi:line:commentstart' => $currentLine -
  1084. $matchedHeaderLinesNum -
  1085. ( $consumedTopLines - 1 ),
  1086. 'swi:line:blockend' => undef,
  1087. 'swi:modifier' => $mod,
  1088. 'swi:indent' => $deepLevel
  1089. };
  1090. PRINT( $file, $currentLine + 1, 'debug',
  1091. "Function detected: '$word', with modifier: '$mod'"
  1092. );
  1093. }
  1094. }
  1095. # Check whether it is a container start
  1096. elsif ( $blockFragLast =~
  1097. m/^($regexpCodeContainerModifier)\s+($regexpCodeContainerIdentifier)($regexpCodeContainerArguments)($regexpCodeBlockStart)$/
  1098. )
  1099. {
  1100. my $mod = $1;
  1101. my $word = $2;
  1102. $mod =~ s/^\s*//;
  1103. $mod =~ s/\s*$//;
  1104. $mod =~ s/[\n\t ]+/ /g;
  1105. if ( $word !~ m/^$regexpCodeKeyword$/ )
  1106. {
  1107. PRINT( $file, $currentLine + 1, 'debug',
  1108. "Container detected: '$word', with modifier: '$mod'"
  1109. );
  1110. $containers[ $deepLevel - 1 ] = $word;
  1111. }
  1112. }
  1113. # Check if block start should be ignored
  1114. elsif ( $blockFragLast =~
  1115. m/($regexpCodeBlockStartIgnore)($regexpCodeBlockStart)$/ )
  1116. {
  1117. PRINT( $file, $currentLine + 1,
  1118. 'debug', "Block start delimeter ignored/missed: '$&'" );
  1119. }
  1120. elsif ( $blockFragLast =~ m/^\s*($regexpCodeBlockStart)$/ )
  1121. {
  1122. PRINT( $file, $currentLine + 1, 'debug',
  1123. "Empty code before block start delimeter detected: '$&'"
  1124. );
  1125. }
  1126. else
  1127. {
  1128. $blockFragLast =~ s/^\s*//;
  1129. PRINT( $file, $currentLine + 1,
  1130. 'error',
  1131. "Unknown type of started block: '$blockFragLast'" );
  1132. $exitCode++;
  1133. }
  1134. }
  1135. else
  1136. {
  1137. # Calculate maximum indent level
  1138. if ( $currentDepth < $deepLevel - $isInFunction )
  1139. {
  1140. $currentDepth = $deepLevel - $isInFunction;
  1141. }
  1142. }
  1143. }
  1144. else
  1145. {
  1146. # block closer detected
  1147. if ( $deepLevel == $isInFunction )
  1148. {
  1149. $isInFunction = 0;
  1150. $result->{$currentFunc}->{'swi:pos:blockend'} = $currentPos;
  1151. $result->{$currentFunc}->{'swi:line:blockend'} = $currentLine;
  1152. $result->{$currentFunc}->{'swi:depth'} = $currentDepth;
  1153. $currentDepth = 0;
  1154. $currentFunc = undef;
  1155. }
  1156. $containers[ $deepLevel - 1 ] = undef;
  1157. $deepLevel--;
  1158. }
  1159. }
  1160. # Initialize GLOBAL function
  1161. $result->{$regexpCodeGlobalFunctionName} = {
  1162. 'swi:pos:blockstart' => 0, # not used
  1163. 'swi:pos:headerstart' => 0, # not used
  1164. 'swi:pos:blockend' => 0, # not used,
  1165. 'swi:line:blockstart' => 0, # not used
  1166. 'swi:line:headerstart' => 0, # used to deattach header with comments
  1167. 'swi:line:commentstart' => 0, # not used
  1168. 'swi:line:blockend' => 0, # not used
  1169. 'swi:modifier' => "", # not used
  1170. 'swi:indent' => 0, # not used
  1171. 'swi:depth' => 0 # not used
  1172. };
  1173. for ( my $i = 0 ; $i <= $#blockComment ; ++$i )
  1174. {
  1175. $result->{$regexpCodeGlobalFunctionName}->{'swi:line:headerstart'} = $i;
  1176. if ( $blockComment[$i] =~ m/^\s*$/ )
  1177. {
  1178. # Empty line detected => header end matched
  1179. last;
  1180. }
  1181. }
  1182. return $result;
  1183. }
  1184. sub swiSourceCodeStringsRemove
  1185. {
  1186. my $code = shift();
  1187. my $result = "";
  1188. my $posPrev = 0;
  1189. my $posCurrent = 0;
  1190. my $isInString = 0;
  1191. my $lastPart = $code;
  1192. my $borderPatternDynamic = $regexpCodeStringBorder_Text;
  1193. while ( $code =~ m/$borderPatternDynamic/g )
  1194. {
  1195. $posPrev = $posCurrent;
  1196. $posCurrent = pos($code);
  1197. my $matchPre = $`;
  1198. my $matchStr = $&;
  1199. my $matchPost = $';
  1200. $lastPart = "";
  1201. my $blockFrag =
  1202. substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );
  1203. if ( $isInString == 0 )
  1204. {
  1205. $result .= $blockFrag . $matchStr;
  1206. $isInString = 1;
  1207. $borderPatternDynamic = $matchStr;
  1208. }
  1209. else
  1210. {
  1211. if ( ( $blockFrag . $matchStr ) =~
  1212. m/($regexpCodeStringBorder_Escape)($borderPatternDynamic)$/ )
  1213. {
  1214. # This string border should be ignored
  1215. $blockFrag =~ s/[^\n]//g;
  1216. $result .= $blockFrag;
  1217. }
  1218. else
  1219. {
  1220. # Save last part only if string end detected;
  1221. $lastPart = $matchPost;
  1222. # Keep newlines in the code inside strings
  1223. $blockFrag =~ s/[^\n]//g;
  1224. $result .= $blockFrag;
  1225. $result .= $matchStr;
  1226. $isInString = 0;
  1227. $borderPatternDynamic = $regexpCodeStringBorder_Text;
  1228. }
  1229. }
  1230. }
  1231. return $result . $lastPart;
  1232. }
  1233. sub swiSourceCodePreprocessorRemove
  1234. {
  1235. my $code = shift();
  1236. my $result = "";
  1237. my @codeLines = swiUtilArrayExtend( [ split( "\n", $code ) ],
  1238. swiMatchPatternCount( $code, '\n' ) - 1, "" );
  1239. my $isInPreprocessor = 0;
  1240. foreach my $line (@codeLines)
  1241. {
  1242. if ( $isInPreprocessor == 1
  1243. || $line =~ m/$regexpCodePreprocessorStart/ )
  1244. {
  1245. $isInPreprocessor = 1;
  1246. # Just add empty line
  1247. $result .= "\n";
  1248. if ( $line =~ m/$regexpCodePreprocessorEnd/ )
  1249. {
  1250. $isInPreprocessor = 0;
  1251. }
  1252. }
  1253. else
  1254. {
  1255. $line =~ s/\n//g;
  1256. $result .= $line . "\n";
  1257. }
  1258. }
  1259. return $result;
  1260. }
  1261. sub swiSourceCommentsDeattach
  1262. {
  1263. my @fileLines = @_;
  1264. my $blockAll = "";
  1265. my $blockCode = "";
  1266. my $blockComment = "";
  1267. my $countLinesAll = 0;
  1268. my $countLinesCode = 0;
  1269. my $countLinesComment = 0;
  1270. my $isInCode = 1;
  1271. foreach my $line (@fileLines)
  1272. {
  1273. if ( $isInCode == 1 )
  1274. {
  1275. if ( $line =~
  1276. m/(($regexpCommentMultiStart)|($regexpCommentSingle))/ )
  1277. {
  1278. my $matchPre = $`;
  1279. my $matchStr = $&;
  1280. my $matchPost = $';
  1281. my $marker = "#@%" . int( rand(0xFF) ) . "%@#";
  1282. if ( swiSourceCodeStringsRemove( $matchPre . $marker ) !~
  1283. m/$marker/ )
  1284. {
  1285. # This block ends inside the string
  1286. # i.e. comment start marker detected inside the string
  1287. # Process again the string with removed comment start marker
  1288. $line =~
  1289. s/(($regexpCommentMultiStart)|($regexpCommentSingle))//;
  1290. $fileLines[$countLinesAll] = $line;
  1291. redo;
  1292. }
  1293. elsif ( $matchStr =~ m/^$regexpCommentMultiStart$/ )
  1294. {
  1295. # Get the code before the comment
  1296. $blockCode .= $matchPre;
  1297. $blockAll .= $matchPre;
  1298. $isInCode = 0;
  1299. $blockComment .= $matchStr;
  1300. $blockAll .= $matchStr;
  1301. # Process again the last fragment
  1302. $fileLines[$countLinesAll] = $matchPost;
  1303. $line = $matchPost;
  1304. redo;
  1305. }
  1306. else
  1307. {
  1308. # Get the code before the comment
  1309. $blockCode .= $matchPre;
  1310. $blockAll .= $matchPre;
  1311. # Single line comment detected
  1312. $matchPost =~ s/\n//g;
  1313. $blockComment .= $matchStr . $matchPost;
  1314. $blockAll .= $matchStr . $matchPost;
  1315. }
  1316. }
  1317. else
  1318. {
  1319. $line =~ s/\n//g;
  1320. $blockCode .= $line;
  1321. $blockAll .= $line;
  1322. }
  1323. }
  1324. else
  1325. {
  1326. # Check multi line comment end
  1327. if ( $line =~ m/$regexpCommentMultiEnd/ )
  1328. {
  1329. my $matchPre = $`;
  1330. my $matchStr = $&;
  1331. my $matchPost = $';
  1332. # Get the code before the comment
  1333. $blockComment .= $matchPre . $matchStr;
  1334. $blockAll .= $matchPre . $matchStr;
  1335. $isInCode = 1;
  1336. # Process again the last fragment
  1337. $fileLines[$countLinesAll] = $matchPost;
  1338. $line = $matchPost;
  1339. redo;
  1340. }
  1341. else
  1342. {
  1343. $line =~ s/\n//g;
  1344. $blockComment .= $line;
  1345. $blockAll .= $line;
  1346. }
  1347. }
  1348. $blockCode .= "\n";
  1349. $blockComment .= "\n";
  1350. $blockAll .= "\n";
  1351. $countLinesAll++;
  1352. }
  1353. return ( $blockAll, $blockCode, $blockComment );
  1354. }
  1355. sub swiMatchPatternCount
  1356. {
  1357. my $text = shift();
  1358. my $pattern = shift();
  1359. my $count = 0;
  1360. while ( $text =~ m/$pattern/g )
  1361. {
  1362. $count++;
  1363. }
  1364. return $count;
  1365. }
  1366. sub swiMatchLinesCount
  1367. {
  1368. my @text = split( "\n", shift() );
  1369. my $pattern = shift();
  1370. my $count = 0;
  1371. foreach (@text)
  1372. {
  1373. if ( $_ =~ m/$pattern/ )
  1374. {
  1375. $count++;
  1376. }
  1377. }
  1378. return $count;
  1379. }
  1380. sub swiUtilArrayExtend
  1381. {
  1382. my $array = shift();
  1383. my $finalLength = shift();
  1384. my $emptySymbol = shift();
  1385. if ( $#{$array} > $finalLength )
  1386. {
  1387. DEBUG( "Length of array: " . $#{$array} );
  1388. DEBUG( "Requested final length: " . $finalLength );
  1389. DEBUG( Dumper($array) );
  1390. die('Internal Error occured!');
  1391. }
  1392. while ( $finalLength - $#{$array} > 0 )
  1393. {
  1394. push( @{$array}, $emptySymbol );
  1395. }
  1396. return @{$array};
  1397. }
  1398. sub swiUtilDirectoryCleanUp
  1399. {
  1400. my $dir = shift();
  1401. die("Internal error!") if not defined $dir;
  1402. die("Internal error!") if $dir eq "";
  1403. die("Internal error!") if $dir eq ".";
  1404. die("Internal error!") if $dir eq "./";
  1405. if ( opendir( DIR, $dir ) )
  1406. {
  1407. while ( my $file = readdir(DIR) )
  1408. {
  1409. unlink $dir . "/" . $file;
  1410. }
  1411. closedir(DIR);
  1412. }
  1413. }
  1414. sub swiUtil_Round
  1415. {
  1416. my $float = shift();
  1417. if ( ( $float - int($float) ) > 0.5 )
  1418. {
  1419. return int( $float + 1.0 );
  1420. }
  1421. else
  1422. {
  1423. return int($float);
  1424. }
  1425. }
  1426. return 1;