Processor.pm 57 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672
  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~]*\s*[:][:]\s*)*((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)
  192. || !defined($dupindexIn)
  193. || !defined($dupindexOut) )
  194. {
  195. die(
  196. "Can not start the internal platform native tool '$rootLocation/dupindex/bin/dupindex.exe'"
  197. );
  198. }
  199. my $dupfinderSettings =
  200. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  201. ->{"swi:indexer:dup"};
  202. if ( defined( $dupfinderSettings->{"swi:minlength"} ) )
  203. {
  204. print $dupindexIn "init_length\n";
  205. print $dupindexIn $dupfinderSettings->{"swi:minlength"} . "\n";
  206. }
  207. if ( defined( $dupfinderSettings->{"swi:proximity"} ) )
  208. {
  209. print $dupindexIn "init_proximity\n";
  210. print $dupindexIn $dupfinderSettings->{"swi:proximity"} . "\n";
  211. }
  212. # TODO: configure individually for every language
  213. # see for todos in dupindex.cpp file
  214. #print $dupindexIn "init_ignorable\n";
  215. #print $dupindexIn "\n";
  216. #print $dupindexIn "init_nonregular\n";
  217. #print $dupindexIn "\n";
  218. opendir( DIR, $swiGlobalDirectory )
  219. or die("Can not open source directory '$swiGlobalDirectory'!");
  220. while ( my $file = readdir(DIR) )
  221. {
  222. if ( $file =~ m/$swiGlobalInclude/ )
  223. {
  224. if ( $swiGlobalExclude ne ""
  225. && $file =~ m/$swiGlobalExclude/ )
  226. {
  227. next;
  228. }
  229. $filesData->{$file} = swiParse(
  230. $swiGlobalDirectory,
  231. $file,
  232. $swiGlobalPreprocessorRules,
  233. $swiGlobalScanerRules,
  234. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  235. ->{"swi:indexer:dup"},
  236. $config->{"swi:modules"}->{"swi:module"}[$moduleId]
  237. ->{"swi:indexer:gcov"}
  238. );
  239. }
  240. }
  241. closedir(DIR);
  242. # Add duplication statistics
  243. if ( defined($swiGlobalDupfinderEnabled)
  244. && $swiGlobalDupfinderEnabled eq 'on' )
  245. {
  246. $filesData = swiSourceIndexDuplicationAdd($filesData);
  247. }
  248. else
  249. {
  250. print $dupindexIn "exit\n";
  251. }
  252. # Prepare XML report
  253. STATUS("Generating the report '$swiGlobalReportLocation'...");
  254. swiXmlReportPrint(
  255. $filesData, $swiGlobalDirectory,
  256. $swiGlobalReportLocation, $swiGlobalModuleName
  257. );
  258. $returnCode = $exitCode;
  259. }
  260. return $returnCode;
  261. }
  262. sub swiXmlReportPrint()
  263. {
  264. my $filesData = shift();
  265. my $curDir = shift();
  266. my $reportLocation = shift();
  267. my $moduleName = shift();
  268. $curDir =~ s/\n$//;
  269. my $fh = new FileHandle( "$reportLocation", "w" )
  270. or die("Can not open output file: $reportLocation!");
  271. print $fh "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
  272. print $fh "<swi:report>\n";
  273. print $fh "\n";
  274. print $fh " <swi:module>\n";
  275. print $fh " <swi:name>" . $moduleName . "</swi:name>\n";
  276. print $fh " <swi:location>" . $curDir . "</swi:location>\n";
  277. print $fh "\n";
  278. print $fh " <swi:info>\n";
  279. print $fh " <swi:version>1</swi:version>\n";
  280. if ( defined( $ENV{USER} ) )
  281. {
  282. print $fh " <swi:user>" . $ENV{USER} . "</swi:user>\n";
  283. }
  284. print $fh " <swi:generator>SWI/PROCESSOR</swi:generator>\n";
  285. print $fh " </swi:info>\n";
  286. print $fh "\n";
  287. my $filesCount = 0;
  288. my $functionsCount = 0;
  289. foreach my $file ( keys %{$filesData} )
  290. {
  291. $filesCount++;
  292. print $fh " <swi:file>\n";
  293. print $fh " <swi:name>" . $file . "</swi:name>\n";
  294. print $fh " <swi:location>" . $file . "</swi:location>\n";
  295. print $fh "\n";
  296. my $functions = $filesData->{$file};
  297. my $localFunctionsCount = 0;
  298. foreach my $function ( keys %$functions )
  299. {
  300. $functionsCount++;
  301. $localFunctionsCount++;
  302. print $fh " <swi:function>\n";
  303. print $fh " " . XMLout( $function, RootName => 'swi:name' );
  304. print $fh " "
  305. . XMLout(
  306. $file . ":"
  307. . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ),
  308. RootName => 'swi:location'
  309. );
  310. print $fh " "
  311. . XMLout( $functions->{$function}->{'swi:modifier'},
  312. RootName => 'swi:modifier' );
  313. print $fh " <swi:pointer"
  314. . " swi:headerstart=\""
  315. . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ) . "\""
  316. . " swi:commentstart=\""
  317. . ( $functions->{$function}->{'swi:line:commentstart'} + 1 )
  318. . "\""
  319. . " swi:blockstart=\""
  320. . ( $functions->{$function}->{'swi:line:blockstart'} + 1 ) . "\""
  321. . " swi:blockend=\""
  322. . ( $functions->{$function}->{'swi:line:blockend'} + 1 ) . "\""
  323. . " />\n";
  324. my $statStr = XMLout(
  325. $functions->{$function}->{'swi:statistic'},
  326. RootName => 'swi:statistic',
  327. GroupTags => {
  328. 'swi:complexity' => '__REMOVE__',
  329. 'swi:duplication' => '__REMOVE__',
  330. 'swi:length' => '__REMOVE__',
  331. 'swi:lines' => '__REMOVE__',
  332. 'swi:checksum' => '__REMOVE__',
  333. 'swi:coverage' => '__REMOVE__'
  334. }
  335. );
  336. $statStr =~ s/\n/\n /g;
  337. $statStr =~ s/ name="__REMOVE__"//g;
  338. print $fh " ";
  339. print $fh $statStr;
  340. print $fh "\n";
  341. my $refStr = XMLout( $functions->{$function}->{'swi:reference'},
  342. RootName => '' );
  343. $refStr =~ s/\n/\n /g;
  344. $refStr =~ s/<anon /<swi:reference /g;
  345. $refStr =~ s/<anon>\s*<\/anon>\s*/\n/g;
  346. print $fh " ";
  347. print $fh $refStr;
  348. print $fh " </swi:function>\n";
  349. print $fh "\n";
  350. }
  351. print $fh " <swi:statistic>\n";
  352. print $fh " <swi:count>\n";
  353. print $fh " <swi:functions swi:exact=\""
  354. . $localFunctionsCount
  355. . "\" />\n";
  356. print $fh " </swi:count>\n";
  357. print $fh " </swi:statistic>\n";
  358. print $fh "\n";
  359. print $fh " </swi:file>\n";
  360. print $fh "\n";
  361. }
  362. print $fh " <swi:statistic>\n";
  363. print $fh " <swi:count>\n";
  364. # Warning: swi_merger requires to have counter of files before counters of functions
  365. print $fh " <swi:files swi:exact=\"" . $filesCount . "\" />\n";
  366. print $fh " <swi:functions swi:exact=\""
  367. . $functionsCount
  368. . "\" />\n";
  369. print $fh " </swi:count>\n";
  370. print $fh " </swi:statistic>\n";
  371. print $fh "\n";
  372. print $fh " </swi:module>\n";
  373. print $fh "\n";
  374. print $fh "</swi:report>\n";
  375. $fh->close();
  376. }
  377. #
  378. # Parser enter point
  379. #
  380. sub swiParse
  381. {
  382. my $location = shift();
  383. my $file = shift();
  384. my $preprocessorRules = shift();
  385. my $scanerRules = shift();
  386. my $dupfinderSettings = shift();
  387. my $gcovSettings = shift();
  388. STATUS("Parsing file: '$location/$file'.");
  389. my $fh = new FileHandle( $location . "/" . $file, "r" )
  390. or die("Can not open input file '$location/$file'!");
  391. my @fileLines = <$fh>;
  392. # Get all types of strings
  393. my ( $globalBlock_Initial, $globalBlock_Code, $globalBlock_Comment ) =
  394. swiSourceCommentsDeattach(@fileLines);
  395. my $globalBlock_NoStr = swiSourceCodeStringsRemove($globalBlock_Code);
  396. my $globalBlock_NoPrep = swiSourceCodePreprocessorRemove($globalBlock_Code);
  397. my $globalBlock_Purified = swiSourceCodeStringsRemove($globalBlock_NoPrep);
  398. # Preprocess purified code
  399. foreach my $rule ( @{$preprocessorRules} )
  400. {
  401. my $pattern = $rule->{'swi:filepattern'};
  402. if ( $file =~ m/$pattern/ )
  403. {
  404. $globalBlock_Purified = swiSourceCodePreprocess(
  405. $globalBlock_Purified,
  406. $rule->{'swi:searchpattern'},
  407. $rule->{'swi:replacepattern'}
  408. );
  409. }
  410. }
  411. # Parse source code
  412. my $functionsData =
  413. swiSourceCodeParse( $file, $globalBlock_Purified, $globalBlock_Comment );
  414. # Adjusting scaner rules (for performance purposes)
  415. my $scanerRulesFiltered = [];
  416. foreach my $rule ( @{$scanerRules} )
  417. {
  418. my $pattern = $rule->{'swi:filepattern'};
  419. if ( $file =~ m/$pattern/ )
  420. {
  421. push( @{$scanerRulesFiltered}, $rule );
  422. }
  423. }
  424. # Add statistics
  425. $functionsData = swiSourceIndexAdd(
  426. $file, $functionsData, $scanerRulesFiltered,
  427. $dupfinderSettings, $globalBlock_Initial, $globalBlock_Code,
  428. $globalBlock_Comment, $globalBlock_NoPrep, $globalBlock_NoStr,
  429. $globalBlock_Purified
  430. );
  431. if ( $gcovSettings->{'swi:enabled'} eq 'on' )
  432. {
  433. my $filePattern = $gcovSettings->{'swi:filepattern'};
  434. if ( $file =~ m/$filePattern/ )
  435. {
  436. swiSourceIndexGcovAdd(
  437. $location, $file, $functionsData,
  438. $gcovSettings->{'swi:sourcefile'},
  439. $gcovSettings->{'swi:gcdafile'}
  440. );
  441. }
  442. }
  443. return $functionsData;
  444. }
  445. sub swiSourceCodePreprocess
  446. {
  447. my $code = shift();
  448. my $search = shift();
  449. my $replace = shift();
  450. my $lastPart = $code;
  451. my $result = "";
  452. my $posPrev = 0;
  453. my $posCurrent = 0;
  454. while ( $code =~ m/$search/g )
  455. {
  456. $posPrev = $posCurrent;
  457. $posCurrent = pos($code);
  458. my $matchStr = $&;
  459. $lastPart = $';
  460. my $replaceString = eval( 'my $tmp = "' . $replace . '";' );
  461. if ( swiMatchPatternCount( $matchStr, '\n' ) !=
  462. swiMatchPatternCount( $replaceString, '\n' ) )
  463. {
  464. die(
  465. "Wrong preprocessor rule detected in the configuration file: it changes number of lines replacing the text\n>>>\n"
  466. . $matchStr
  467. . "\n<<<\nby\n>>>\n"
  468. . $replaceString
  469. . "\n<<<\n" );
  470. }
  471. my $blockFrag =
  472. substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );
  473. $result .= ( $blockFrag . $replaceString );
  474. }
  475. $result .= $lastPart;
  476. return $result;
  477. }
  478. sub swiSourceCodeScan
  479. {
  480. my $file = shift();
  481. my $offset = shift();
  482. my $code = shift();
  483. my $search = shift();
  484. my $message = shift();
  485. my @result = [];
  486. while ( $code =~ m/$search/g )
  487. {
  488. my $matchPre = $`;
  489. my $matchStr = $&;
  490. my $linePos = swiMatchPatternCount( $matchPre . $matchStr, '\n' ) + 1;
  491. my $messageString = eval( 'my $tmp = "' . $message . '";' );
  492. push(
  493. @result,
  494. {
  495. 'swi:ref:type' => 'scan',
  496. 'swi:scan:file' => $file,
  497. 'swi:scan:line' => $linePos + $offset,
  498. 'swi:scan:message' => $messageString
  499. }
  500. );
  501. }
  502. return @result;
  503. }
  504. sub swiSourceCodeGlobalGet
  505. {
  506. my $functionsData = shift();
  507. my $endLine = shift();
  508. my @blockCodeAgr = @_;
  509. my @blockCode;
  510. if ( $#blockCodeAgr == 0 )
  511. {
  512. # Continues code string provided
  513. @blockCode = split( "\n", $blockCodeAgr[0] );
  514. }
  515. else
  516. {
  517. # Array of lines provided
  518. @blockCode = @blockCodeAgr;
  519. }
  520. if ( !defined($endLine) )
  521. {
  522. $endLine = $#blockCode + 100; # Just with overhead
  523. }
  524. foreach my $function ( values %{$functionsData} )
  525. {
  526. for (
  527. my $i = $function->{'swi:line:commentstart'} ;
  528. $i <= $function->{'swi:line:blockend'} ;
  529. $i++
  530. )
  531. {
  532. # Clear line if it is inside function
  533. $blockCode[$i] = "";
  534. }
  535. }
  536. my $result = "";
  537. foreach (@blockCode)
  538. {
  539. $endLine--;
  540. if ( $endLine < 0 )
  541. {
  542. last;
  543. }
  544. $result .= $_ . "\n";
  545. }
  546. return $result;
  547. }
  548. sub swiDupindexFunctionAdd
  549. {
  550. my $fileName = shift();
  551. my $functionName = shift();
  552. my $functionCode = shift();
  553. print $dupindexIn "init_file\n";
  554. print $dupindexIn length($fileName) . "\n";
  555. print $dupindexIn length($functionName) . "\n";
  556. print $dupindexIn length($functionCode) . "\n";
  557. print $dupindexIn $fileName . $functionName . $functionCode . "\n";
  558. }
  559. sub swiSourceIndexAdd
  560. {
  561. my $file = shift();
  562. my $functionsData = shift();
  563. my $scanerRules = shift();
  564. my $dupfinderSettings = shift();
  565. my @block_Initial = split( "\n", shift() );
  566. my @block_Code = split( "\n", shift() );
  567. my @block_Comment = split( "\n", shift() );
  568. my @block_NoPrep = split( "\n", shift() );
  569. my @block_NoStr = split( "\n", shift() );
  570. my $block_Purified = shift();
  571. # Extend arrays in order to remove warnings
  572. my $finalLinesNum = swiMatchPatternCount( $block_Purified, '\n' ) + 1;
  573. @block_Initial = swiUtilArrayExtend( [@block_Initial], $finalLinesNum, "" );
  574. @block_Code = swiUtilArrayExtend( [@block_Code], $finalLinesNum, "" );
  575. @block_Comment = swiUtilArrayExtend( [@block_Comment], $finalLinesNum, "" );
  576. @block_NoPrep = swiUtilArrayExtend( [@block_NoPrep], $finalLinesNum, "" );
  577. @block_NoStr = swiUtilArrayExtend( [@block_NoStr], $finalLinesNum, "" );
  578. foreach my $functionName ( keys %{$functionsData} )
  579. {
  580. my $function = $functionsData->{$functionName};
  581. my $block = {};
  582. my $blockOffset = {};
  583. # Initialize function name
  584. $block->{'functionname'} = $functionName;
  585. $block->{'functionname'} =~
  586. s/($regexpCodeContainerDelimeter)?($regexpCodeContainerIdentifier$regexpCodeContainerDelimeter)*($regexpCodeFunctionIdentifier)/$3/;
  587. $blockOffset->{'functionname'} = $function->{'swi:line:headerstart'};
  588. if ( $functionName ne $regexpCodeGlobalFunctionName )
  589. {
  590. # Get content
  591. $block->{'initial'} = "";
  592. $blockOffset->{'initial'} = $function->{'swi:line:commentstart'};
  593. for (
  594. my $i = $function->{'swi:line:commentstart'} ;
  595. $i <= $function->{'swi:line:blockend'} ;
  596. $i++
  597. )
  598. {
  599. $block->{'initial'} .= $block_Initial[$i] . "\n";
  600. }
  601. $block->{'code'} = "";
  602. $blockOffset->{'code'} = $function->{'swi:line:commentstart'};
  603. for (
  604. my $i = $function->{'swi:line:commentstart'} ;
  605. $i <= $function->{'swi:line:blockend'} ;
  606. $i++
  607. )
  608. {
  609. $block->{'code'} .= $block_Code[$i] . "\n";
  610. }
  611. $block->{'comments'} = "";
  612. $blockOffset->{'comments'} = $function->{'swi:line:commentstart'};
  613. for (
  614. my $i = $function->{'swi:line:commentstart'} ;
  615. $i <= $function->{'swi:line:blockend'} ;
  616. $i++
  617. )
  618. {
  619. $block->{'comments'} .= $block_Comment[$i] . "\n";
  620. }
  621. $block->{'nopreprocessor'} = "";
  622. $blockOffset->{'nopreprocessor'} =
  623. $function->{'swi:line:commentstart'};
  624. for (
  625. my $i = $function->{'swi:line:commentstart'} ;
  626. $i <= $function->{'swi:line:blockend'} ;
  627. $i++
  628. )
  629. {
  630. $block->{'nopreprocessor'} .= $block_NoPrep[$i] . "\n";
  631. }
  632. $block->{'nostrings'} = "";
  633. $blockOffset->{'nostrings'} = $function->{'swi:line:commentstart'};
  634. for (
  635. my $i = $function->{'swi:line:commentstart'} ;
  636. $i <= $function->{'swi:line:blockend'} ;
  637. $i++
  638. )
  639. {
  640. $block->{'nostrings'} .= $block_NoStr[$i] . "\n";
  641. }
  642. $block->{'purified'} = substr(
  643. $block_Purified,
  644. $function->{'swi:pos:headerstart'},
  645. $function->{'swi:pos:blockend'} -
  646. $function->{'swi:pos:headerstart'}
  647. )
  648. . "\n";
  649. $blockOffset->{'purified'} = $function->{'swi:line:headerstart'};
  650. $block->{'commentshead'} = "";
  651. $blockOffset->{'commentshead'} =
  652. $function->{'swi:line:commentstart'};
  653. for (
  654. my $i = $function->{'swi:line:commentstart'} ;
  655. $i < $function->{'swi:line:headerstart'} ;
  656. $i++
  657. )
  658. {
  659. $block->{'commentshead'} .= $block_Comment[$i] . "\n";
  660. }
  661. $block->{'functionhead'} = substr(
  662. $block_Purified,
  663. $function->{'swi:pos:headerstart'},
  664. $function->{'swi:pos:blockstart'} -
  665. $function->{'swi:pos:headerstart'}
  666. )
  667. . "\n";
  668. $blockOffset->{'functionhead'} =
  669. $function->{'swi:line:headerstart'};
  670. $block->{'functionbody'} = substr(
  671. $block_Purified,
  672. $function->{'swi:pos:blockstart'},
  673. $function->{'swi:pos:blockend'} -
  674. $function->{'swi:pos:blockstart'}
  675. )
  676. . "\n";
  677. $blockOffset->{'functionbody'} = $function->{'swi:line:blockstart'};
  678. }
  679. else
  680. {
  681. $block->{'initial'} =
  682. swiSourceCodeGlobalGet( $functionsData, undef, @block_Initial );
  683. $blockOffset->{'initial'} = 0;
  684. $block->{'code'} =
  685. swiSourceCodeGlobalGet( $functionsData, undef, @block_Code );
  686. $blockOffset->{'code'} = 0;
  687. $block->{'comments'} =
  688. swiSourceCodeGlobalGet( $functionsData, undef, @block_Comment );
  689. $blockOffset->{'comments'} = 0;
  690. $block->{'nopreprocessor'} =
  691. swiSourceCodeGlobalGet( $functionsData, undef, @block_NoPrep );
  692. $blockOffset->{'nopreprocessor'} = 0;
  693. $block->{'nostrings'} =
  694. swiSourceCodeGlobalGet( $functionsData, undef, @block_NoStr );
  695. $blockOffset->{'nostrings'} = 0;
  696. $block->{'purified'} =
  697. swiSourceCodeGlobalGet( $functionsData, undef, $block_Purified );
  698. $blockOffset->{'purified'} = 0;
  699. $block->{'commentshead'} =
  700. swiSourceCodeGlobalGet( $functionsData,
  701. $function->{'swi:line:headerstart'},
  702. @block_Comment );
  703. $blockOffset->{'commentshead'} = 0;
  704. $block->{'functionhead'} = ""; # N/A
  705. $blockOffset->{'functionhead'} = 0;
  706. $block->{'functionbody'} = ""; # N/A
  707. $blockOffset->{'functionbody'} = 0;
  708. }
  709. # Initialize container
  710. $function->{'swi:statistic'} = {
  711. 'swi:length' => {
  712. 'swi:source' => {},
  713. 'swi:executable' => {},
  714. 'swi:comment' => {},
  715. 'swi:blank' => {},
  716. 'swi:function:name' => {}
  717. },
  718. 'swi:lines' => {
  719. 'swi:source' => {},
  720. 'swi:executable' => {},
  721. 'swi:comment' => {},
  722. 'swi:blank' => {},
  723. 'swi:comment:header' => {}
  724. },
  725. 'swi:complexity' => {
  726. 'swi:cyclomatic' => {},
  727. 'swi:blocks' => {},
  728. 'swi:maxdepth' => {}
  729. },
  730. 'swi:duplication' => { 'swi:symbols' => { 'swi:exact' => 0 }, },
  731. 'swi:checksum' => { 'swi:source' => { 'swi:exact' => 0 }, }
  732. };
  733. $function->{'swi:reference'} = [];
  734. # Calculate swi:length->swi:source
  735. # Note: this statistic is used to detect differences
  736. # Global code is compared without new lines
  737. my $initialContent = $block->{'initial'};
  738. if ( $functionName eq $regexpCodeGlobalFunctionName )
  739. {
  740. $initialContent =~ s/\n+//g;
  741. }
  742. $function->{'swi:statistic'}->{'swi:length'}->{'swi:source'}
  743. ->{'swi:exact'} = length($initialContent);
  744. # Calculate swi:length->swi:executable
  745. $function->{'swi:statistic'}->{'swi:length'}->{'swi:executable'}
  746. ->{'swi:exact'} = length( $block->{'purified'} );
  747. # Calculate swi:length->swi:comment
  748. $function->{'swi:statistic'}->{'swi:length'}->{'swi:comment'}
  749. ->{'swi:exact'} = length( $block->{'comments'} );
  750. # Calculate swi:length->swi:blank
  751. $function->{'swi:statistic'}->{'swi:length'}->{'swi:blank'}
  752. ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\s' );
  753. # Calculate swi:length->swi:function-name
  754. $function->{'swi:statistic'}->{'swi:length'}->{'swi:function:name'}
  755. ->{'swi:exact'} = length( $block->{'functionname'} );
  756. # Calculate swi:lines->swi:source
  757. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:source'}
  758. ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\n' );
  759. # Calculate swi:lines->swi:executable
  760. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:executable'}
  761. ->{'swi:exact'} =
  762. swiMatchLinesCount( $block->{'purified'}, '[^ \t]' );
  763. # Calculate swi:lines->swi:comment
  764. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment'}
  765. ->{'swi:exact'} =
  766. swiMatchLinesCount( $block->{'comments'}, '[^ \t]' );
  767. # Calculate swi:lines->swi:blank
  768. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:blank'}
  769. ->{'swi:exact'} = swiMatchLinesCount( $block->{'initial'}, '^\s*$' );
  770. # Calculate swi:lines->swi:comment:header
  771. $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment:header'}
  772. ->{'swi:exact'} =
  773. $function->{'swi:line:headerstart'} -
  774. $function->{'swi:line:commentstart'};
  775. # Calculate swi:complexity->swi:cyclomatic
  776. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:cyclomatic'}
  777. ->{'swi:exact'} =
  778. swiMatchPatternCount(
  779. swiSourceCodeStringsRemove( $block->{'purified'} ),
  780. $regexpCodeMatch_ComplexityCyclomatic );
  781. # Calculate swi:complexity->swi:blocks
  782. # -1 in order not to count main function's block
  783. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:blocks'}
  784. ->{'swi:exact'} =
  785. swiMatchPatternCount( $block->{'purified'}, $regexpCodeBlockStart ) -
  786. 1;
  787. # Calculate swi:complexity->swi:maxdepth
  788. $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:maxdepth'}
  789. ->{'swi:exact'} = $function->{'swi:depth'};
  790. # Calculate swi:checksum->swi:index
  791. # Note: this statistic is used to detect differences
  792. # Global code is compared without new lines
  793. my @symbols = split( //, $initialContent );
  794. my $crcSumTotal = 0;
  795. for ( my $pos = 0 ; $pos <= $#symbols ; $pos++ )
  796. {
  797. $crcSumTotal =
  798. ( $crcSumTotal << 8 )
  799. ^ $crctab[ ( $crcSumTotal >> 24 ) ^ ( unpack 'C', $symbols[$pos] )
  800. ];
  801. }
  802. $function->{'swi:statistic'}->{'swi:checksum'}->{'swi:source'}
  803. ->{'swi:exact'} = $crcSumTotal;
  804. # Scan function by scaner tool
  805. foreach my $rule ( @{$scanerRules} )
  806. {
  807. if ( defined( $block->{ $rule->{'swi:codecontent'} } ) )
  808. {
  809. push(
  810. @{ $function->{'swi:reference'} },
  811. swiSourceCodeScan(
  812. $file,
  813. $blockOffset->{ $rule->{'swi:codecontent'} },
  814. $block->{ $rule->{'swi:codecontent'} },
  815. $rule->{'swi:searchpattern'},
  816. $rule->{'swi:messagepattern'}
  817. )
  818. );
  819. }
  820. else
  821. {
  822. STATUS(
  823. "Wrong configuiration: 'swi:scaner/swi:rule/swi:codecontent' property is not from the acceptable set of values!"
  824. );
  825. $exitCode++;
  826. }
  827. }
  828. # Add to dupindexer for further processing
  829. if ( defined( $block->{ $dupfinderSettings->{'swi:codecontent'} } ) )
  830. {
  831. if (
  832. $functionName ne $regexpCodeGlobalFunctionName
  833. || ( defined( $dupfinderSettings->{'swi:globalcode'} )
  834. && $dupfinderSettings->{'swi:globalcode'} eq 'on' )
  835. )
  836. {
  837. swiDupindexFunctionAdd( $file, $functionName,
  838. $block->{ $dupfinderSettings->{'swi:codecontent'} } );
  839. }
  840. }
  841. else
  842. {
  843. STATUS(
  844. "Wrong configuiration: 'swi:indexer:dup/swi:codecontent' property is not from the acceptable set of values!"
  845. );
  846. $exitCode++;
  847. }
  848. }
  849. return $functionsData;
  850. }
  851. #
  852. # This function uses external tool for duplication collection
  853. #
  854. sub swiSourceIndexDuplicationAdd
  855. {
  856. my $filesData = shift();
  857. STATUS("Searching for duplication...");
  858. print $dupindexIn "start\n";
  859. my $outStream = "";
  860. while ( defined($dupindexOut) && ( my $line = <$dupindexOut> ) )
  861. {
  862. $outStream .= $line;
  863. }
  864. my @dupdataGoups = split( /info: group_start/, $outStream );
  865. foreach (@dupdataGoups)
  866. {
  867. my @parsedData;
  868. my @dupdataSplit = split( /\n/, $_ );
  869. foreach (@dupdataSplit)
  870. {
  871. if ( $_ =~
  872. m/duplication: file: '(.*)' function: '(.*)' possition: '(.*)' size: '(.*)'/
  873. )
  874. {
  875. $filesData->{$1}->{$2}->{'swi:statistic'}->{'swi:duplication'}
  876. ->{'swi:symbols'}->{'swi:exact'} += $4;
  877. push(
  878. @parsedData,
  879. {
  880. 'swi:ref:type' => 'dup',
  881. 'swi:dup:file' => $1,
  882. 'swi:dup:function' => $2,
  883. 'swi:dup:line' => $3 +
  884. $filesData->{$1}->{$2}->{'swi:line:headerstart'},
  885. 'swi:dup:size' => $4
  886. }
  887. );
  888. }
  889. }
  890. foreach my $dupData (@parsedData)
  891. {
  892. push(
  893. @{
  894. $filesData->{ $dupData->{'swi:dup:file'} }
  895. ->{ $dupData->{'swi:dup:function'} }->{'swi:reference'}
  896. },
  897. @parsedData
  898. );
  899. }
  900. }
  901. my $errStream = "";
  902. while ( defined($dupindexErr) && ( my $line = <$dupindexErr> ) )
  903. {
  904. STATUS("Internal dupindex tool detected the error.");
  905. STATUS($line);
  906. STATUS(" 1. Check 'swi:indexer:dup' section in configuration.");
  907. STATUS(
  908. " 2. Check that swi/dupindex tool is runable on your system/platform."
  909. );
  910. STATUS(" 3. Recompile swi/dupindex tool for your system/platform.");
  911. STATUS(" 4. Report the problem to developers.");
  912. # The final return code is unsuccessful
  913. # It means that these errors/warnings should be fixed before the next processing
  914. $exitCode++;
  915. }
  916. return $filesData;
  917. }
  918. sub swiSourceIndexGcovAdd
  919. {
  920. my $location = shift();
  921. my $file = shift();
  922. my $functionsData = shift();
  923. my $filePattern = shift();
  924. my @listTmp = $file =~ m/$filePattern/;
  925. my $gcdaFile = eval( 'my $tmp = "' . shift() . '";' );
  926. # Add coverage statistic
  927. my $fh = new FileHandle( $location . "/" . $gcdaFile, "r" );
  928. if ( !defined($fh) )
  929. {
  930. STATUS(
  931. "gcda file '$location/$gcdaFile' is not found for the '$file' source."
  932. );
  933. #foreach my $functionName ( keys %{$functionsData} )
  934. #{
  935. # $functionsData->{$functionName}->{'swi:statistic'}
  936. # ->{'swi:coverage'} = {
  937. # 'swi:gsum:lines' => { 'swi:exact' => 0 },
  938. # 'swi:gsum:branches' => { 'swi:exact' => 0 },
  939. # 'swi:gsum:calls' => { 'swi:exact' => 0 },
  940. # 'swi:gcov:lines' => { 'swi:exact' => 0 },
  941. # 'swi:gcov:branches' => { 'swi:exact' => 0 },
  942. # 'swi:gcov:takenonce' => { 'swi:exact' => 0 },
  943. # 'swi:gcov:calls' => { 'swi:exact' => 0 }
  944. # };
  945. #}
  946. }
  947. else
  948. {
  949. my $gcovCommand = "gcov -f -b $location/$gcdaFile";
  950. my $gcovData = `$gcovCommand`;
  951. $gcovData =~ s/No executable lines/Lines executed:100.OO% of O/g;
  952. $gcovData =~ s/No calls/Calls executed:100.00% of O/g;
  953. $gcovData =~
  954. s/No branches/Branches executed:100.O0% of O\nTaken at least once:100.O0% of O/g;
  955. my @covData = split( "\n\n", $gcovData );
  956. foreach (@covData)
  957. {
  958. next if ( $_ =~ m/^File/ );
  959. my (
  960. $functionName, $linesExec, $linesTotal, $branchesExec,
  961. $branchesTotal, $takenOnce, $callsExec, $callsTotal
  962. )
  963. = ( $_ =~
  964. 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+(.*)/
  965. );
  966. if ( defined( $functionsData->{$functionName} ) )
  967. {
  968. $functionsData->{$functionName}->{'swi:statistic'}
  969. ->{'swi:coverage'} = {
  970. 'swi:gsum:lines' => { 'swi:exact' => $linesTotal },
  971. 'swi:gsum:branches' => { 'swi:exact' => $branchesTotal },
  972. 'swi:gsum:calls' => { 'swi:exact' => $callsTotal },
  973. 'swi:gcov:lines' => {
  974. 'swi:exact' =>
  975. swiUtil_Round( $linesExec * $linesTotal / 100 )
  976. },
  977. 'swi:gcov:branches' => {
  978. 'swi:exact' =>
  979. swiUtil_Round( $branchesExec * $branchesTotal / 100 )
  980. },
  981. 'swi:gcov:takenonce' => {
  982. 'swi:exact' =>
  983. swiUtil_Round( $takenOnce * $branchesTotal / 100 )
  984. },
  985. 'swi:gcov:calls' => {
  986. 'swi:exact' =>
  987. swiUtil_Round( $callsExec * $callsTotal / 100 )
  988. }
  989. };
  990. }
  991. else
  992. {
  993. STATUS(
  994. "gcov reports the data for '$functionName' function but SWI parser did not detect it"
  995. );
  996. $exitCode++;
  997. }
  998. }
  999. }
  1000. }
  1001. sub swiSourceCodeParse
  1002. {
  1003. my $file = shift();
  1004. my $blockCode = shift();
  1005. my @blockComment = split( "\n", shift() );
  1006. @blockComment =
  1007. swiUtilArrayExtend( [@blockComment],
  1008. swiMatchPatternCount( $blockCode, '\n' ) + 1, "" );
  1009. my $result = {};
  1010. my $deepLevel = 0;
  1011. if ( swiMatchPatternCount( $blockCode, $regexpCodeBlockStart ) !=
  1012. swiMatchPatternCount( $blockCode, $regexpCodeBlockEnd ) )
  1013. {
  1014. PRINT( $file, 0, "error",
  1015. "Mismatch in number of start/end of blocks delimeters!\n" );
  1016. DEBUG("The code before parsing:\n$blockCode");
  1017. return $result;
  1018. }
  1019. my $posPrev = 0;
  1020. my $posCurrent = 0;
  1021. my $isInFunction = 0;
  1022. my $currentFunc = undef;
  1023. my $currentLine = 0;
  1024. my $currentPos = 0;
  1025. my $currentDepth = 0;
  1026. my @containers;
  1027. while ( $blockCode =~ m/($regexpCodeBlockStart)|($regexpCodeBlockEnd)/g )
  1028. {
  1029. $posPrev = $posCurrent;
  1030. $posCurrent = pos($blockCode);
  1031. my $matchPre = $`;
  1032. my $matchStr = $&;
  1033. my $matchPost = $';
  1034. my $blockFragFull =
  1035. substr( $blockCode, $posPrev, $posCurrent - $posPrev );
  1036. $currentLine += swiMatchPatternCount( $blockFragFull, "\n" );
  1037. $currentPos += length($blockFragFull);
  1038. if ( $matchStr =~ m/^$regexpCodeBlockStart$/ )
  1039. {
  1040. my $blockFragLast = $blockFragFull;
  1041. $blockFragLast =~ s/^($regexpCodeStatements)*\s*//;
  1042. # opened block detected
  1043. $deepLevel++;
  1044. if ( $isInFunction == 0 )
  1045. {
  1046. # Check whether it is a function start
  1047. if ( $blockFragLast =~
  1048. m/^($regexpCodeFunctionModifier)*($regexpCodeFunctionIdentifier)($regexpCodeFunctionArguments)($regexpCodeBlockStart)$/
  1049. )
  1050. {
  1051. my $matchedHeader = $&;
  1052. my $mod = $1;
  1053. my $word = $2;
  1054. if ( !defined($mod) )
  1055. {
  1056. $mod = "";
  1057. }
  1058. # Remove empty symbols in header
  1059. $matchedHeader =~ s/^\s*//;
  1060. # Check if modifier consumes something from identifier
  1061. # and return back the last part from modifier to identifier
  1062. ( $mod . $word ) =~ m/$regexpCodeFunctionIdentifier$/;
  1063. $mod = $`;
  1064. $word = $&;
  1065. # Remove empty symbols in identifier
  1066. $word =~ s/\s+$//;
  1067. $word =~ s/[\n\t ]+/ /g;
  1068. $word =~
  1069. s/\s*$regexpCodeContainerDelimeter\s*/$regexpCodeContainerDelimeter/;
  1070. # Remove empty symbols in modifier
  1071. $mod =~ s/^\s*//;
  1072. $mod =~ s/\s*$//;
  1073. $mod =~ s/[\n\t ]+/ /g;
  1074. if ( $word !~ m/^($regexpCodeKeyword)$/ )
  1075. {
  1076. $isInFunction = $deepLevel;
  1077. # Attach containers to the name of function
  1078. foreach my $container ( reverse @containers )
  1079. {
  1080. if ( defined($container) )
  1081. {
  1082. $word = $container
  1083. . $regexpCodeContainerDelimeter
  1084. . $word;
  1085. }
  1086. }
  1087. # Add the code before the block start
  1088. # (name of function, arguments, ..)
  1089. my $matchedHeaderLinesNum =
  1090. swiMatchPatternCount( $matchedHeader, "\n" );
  1091. # Check if there are comments before the header
  1092. my $consumedTopLines = 1;
  1093. while (
  1094. $currentLine - $matchedHeaderLinesNum -
  1095. $consumedTopLines >= 0
  1096. && $blockComment[
  1097. $currentLine - $matchedHeaderLinesNum -
  1098. $consumedTopLines
  1099. ] !~ m/^\s*$/
  1100. )
  1101. {
  1102. $consumedTopLines++;
  1103. }
  1104. if ( defined( $result->{$word} ) )
  1105. {
  1106. PRINT( $file, $currentLine + 1, 'debug',
  1107. "The same function detected more than once: '$word'"
  1108. );
  1109. my $counter = 2;
  1110. while (
  1111. defined(
  1112. $result->{ $word . " (" . $counter . ")" }
  1113. )
  1114. )
  1115. {
  1116. $counter++;
  1117. }
  1118. $word .= " (" . $counter . ")";
  1119. }
  1120. # Store data in result
  1121. $currentFunc = $word;
  1122. $result->{$word} = {
  1123. 'swi:pos:blockstart' => $currentPos,
  1124. 'swi:pos:headerstart' => $currentPos -
  1125. length($matchedHeader),
  1126. 'swi:pos:blockend' => undef,
  1127. 'swi:line:blockstart' => $currentLine,
  1128. 'swi:line:headerstart' => $currentLine -
  1129. $matchedHeaderLinesNum,
  1130. 'swi:line:commentstart' => $currentLine -
  1131. $matchedHeaderLinesNum -
  1132. ( $consumedTopLines - 1 ),
  1133. 'swi:line:blockend' => undef,
  1134. 'swi:modifier' => $mod,
  1135. 'swi:indent' => $deepLevel
  1136. };
  1137. PRINT( $file, $currentLine + 1, 'debug',
  1138. "Function detected: '$word', with modifier: '$mod'"
  1139. );
  1140. }
  1141. }
  1142. # Check whether it is a container start
  1143. elsif ( $blockFragLast =~
  1144. m/^($regexpCodeContainerModifier)\s+($regexpCodeContainerIdentifier)($regexpCodeContainerArguments)($regexpCodeBlockStart)$/
  1145. )
  1146. {
  1147. my $mod = $1;
  1148. my $word = $2;
  1149. $mod =~ s/^\s*//;
  1150. $mod =~ s/\s*$//;
  1151. $mod =~ s/[\n\t ]+/ /g;
  1152. if ( $word !~ m/^$regexpCodeKeyword$/ )
  1153. {
  1154. PRINT( $file, $currentLine + 1, 'debug',
  1155. "Container detected: '$word', with modifier: '$mod'"
  1156. );
  1157. $containers[ $deepLevel - 1 ] = $word;
  1158. }
  1159. }
  1160. # Check if block start should be ignored
  1161. elsif ( $blockFragLast =~
  1162. m/($regexpCodeBlockStartIgnore)($regexpCodeBlockStart)$/ )
  1163. {
  1164. PRINT( $file, $currentLine + 1,
  1165. 'debug', "Block start delimeter ignored/missed: '$&'" );
  1166. }
  1167. elsif ( $blockFragLast =~ m/^\s*($regexpCodeBlockStart)$/ )
  1168. {
  1169. PRINT( $file, $currentLine + 1, 'debug',
  1170. "Empty code before block start delimeter detected: '$&'"
  1171. );
  1172. }
  1173. else
  1174. {
  1175. $blockFragLast =~ s/^\s*//;
  1176. PRINT( $file, $currentLine + 1,
  1177. 'error',
  1178. "Unknown type of started block: '$blockFragLast'" );
  1179. $exitCode++;
  1180. }
  1181. }
  1182. else
  1183. {
  1184. # Calculate maximum indent level
  1185. if ( $currentDepth < $deepLevel - $isInFunction )
  1186. {
  1187. $currentDepth = $deepLevel - $isInFunction;
  1188. }
  1189. }
  1190. }
  1191. else
  1192. {
  1193. # block closer detected
  1194. if ( $deepLevel == $isInFunction )
  1195. {
  1196. $isInFunction = 0;
  1197. $result->{$currentFunc}->{'swi:pos:blockend'} = $currentPos;
  1198. $result->{$currentFunc}->{'swi:line:blockend'} = $currentLine;
  1199. $result->{$currentFunc}->{'swi:depth'} = $currentDepth;
  1200. $currentDepth = 0;
  1201. $currentFunc = undef;
  1202. }
  1203. $containers[ $deepLevel - 1 ] = undef;
  1204. $deepLevel--;
  1205. }
  1206. }
  1207. # Initialize GLOBAL function
  1208. $result->{$regexpCodeGlobalFunctionName} = {
  1209. 'swi:pos:blockstart' => 0, # not used
  1210. 'swi:pos:headerstart' => 0, # not used
  1211. 'swi:pos:blockend' => 0, # not used,
  1212. 'swi:line:blockstart' => 0, # not used
  1213. 'swi:line:headerstart' => 0, # used to deattach header with comments
  1214. 'swi:line:commentstart' => 0, # not used
  1215. 'swi:line:blockend' => 0, # not used
  1216. 'swi:modifier' => "", # not used
  1217. 'swi:indent' => 0, # not used
  1218. 'swi:depth' => 0 # not used
  1219. };
  1220. for ( my $i = 0 ; $i <= $#blockComment ; ++$i )
  1221. {
  1222. $result->{$regexpCodeGlobalFunctionName}->{'swi:line:headerstart'} = $i;
  1223. if ( $blockComment[$i] =~ m/^\s*$/ )
  1224. {
  1225. # Empty line detected => header end matched
  1226. last;
  1227. }
  1228. }
  1229. return $result;
  1230. }
  1231. sub swiSourceCodeStringsRemove
  1232. {
  1233. my $code = shift();
  1234. my $result = "";
  1235. my $posPrev = 0;
  1236. my $posCurrent = 0;
  1237. my $isInString = 0;
  1238. my $lastPart = $code;
  1239. my $borderPatternDynamic = $regexpCodeStringBorder_Text;
  1240. while ( $code =~ m/$borderPatternDynamic/g )
  1241. {
  1242. $posPrev = $posCurrent;
  1243. $posCurrent = pos($code);
  1244. my $matchPre = $`;
  1245. my $matchStr = $&;
  1246. my $matchPost = $';
  1247. $lastPart = "";
  1248. my $blockFrag =
  1249. substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );
  1250. if ( $isInString == 0 )
  1251. {
  1252. $result .= $blockFrag . $matchStr;
  1253. $isInString = 1;
  1254. $borderPatternDynamic = $matchStr;
  1255. }
  1256. else
  1257. {
  1258. if ( ( $blockFrag . $matchStr ) =~
  1259. m/($regexpCodeStringBorder_Escape)($borderPatternDynamic)$/ )
  1260. {
  1261. # This string border should be ignored
  1262. $blockFrag =~ s/[^\n]//g;
  1263. $result .= $blockFrag;
  1264. }
  1265. else
  1266. {
  1267. # Save last part only if string end detected;
  1268. $lastPart = $matchPost;
  1269. # Keep newlines in the code inside strings
  1270. $blockFrag =~ s/[^\n]//g;
  1271. $result .= $blockFrag;
  1272. $result .= $matchStr;
  1273. $isInString = 0;
  1274. $borderPatternDynamic = $regexpCodeStringBorder_Text;
  1275. }
  1276. }
  1277. }
  1278. return $result . $lastPart;
  1279. }
  1280. sub swiSourceCodePreprocessorRemove
  1281. {
  1282. my $code = shift();
  1283. my $result = "";
  1284. my @codeLines = swiUtilArrayExtend( [ split( "\n", $code ) ],
  1285. swiMatchPatternCount( $code, '\n' ) - 1, "" );
  1286. my $isInPreprocessor = 0;
  1287. foreach my $line (@codeLines)
  1288. {
  1289. if ( $isInPreprocessor == 1
  1290. || $line =~ m/$regexpCodePreprocessorStart/ )
  1291. {
  1292. $isInPreprocessor = 1;
  1293. # Just add empty line
  1294. $result .= "\n";
  1295. if ( $line =~ m/$regexpCodePreprocessorEnd/ )
  1296. {
  1297. $isInPreprocessor = 0;
  1298. }
  1299. }
  1300. else
  1301. {
  1302. $line =~ s/\n//g;
  1303. $result .= $line . "\n";
  1304. }
  1305. }
  1306. return $result;
  1307. }
  1308. sub swiSourceCommentsDeattach
  1309. {
  1310. my @fileLines = @_;
  1311. my $blockAll = "";
  1312. my $blockCode = "";
  1313. my $blockComment = "";
  1314. my $countLinesAll = 0;
  1315. my $countLinesCode = 0;
  1316. my $countLinesComment = 0;
  1317. my $isInCode = 1;
  1318. foreach my $line (@fileLines)
  1319. {
  1320. if ( $isInCode == 1 )
  1321. {
  1322. if ( $line =~
  1323. m/(($regexpCommentMultiStart)|($regexpCommentSingle))/ )
  1324. {
  1325. my $matchPre = $`;
  1326. my $matchStr = $&;
  1327. my $matchPost = $';
  1328. my $marker = "#@%" . int( rand(0xFF) ) . "%@#";
  1329. if ( swiSourceCodeStringsRemove( $matchPre . $marker ) !~
  1330. m/$marker/ )
  1331. {
  1332. # This block ends inside the string
  1333. # i.e. comment start marker detected inside the string
  1334. # Process again the string with removed comment start marker
  1335. $line =~
  1336. s/(($regexpCommentMultiStart)|($regexpCommentSingle))//;
  1337. $fileLines[$countLinesAll] = $line;
  1338. redo;
  1339. }
  1340. elsif ( $matchStr =~ m/^$regexpCommentMultiStart$/ )
  1341. {
  1342. # Get the code before the comment
  1343. $blockCode .= $matchPre;
  1344. $blockAll .= $matchPre;
  1345. $isInCode = 0;
  1346. $blockComment .= $matchStr;
  1347. $blockAll .= $matchStr;
  1348. # Process again the last fragment
  1349. $fileLines[$countLinesAll] = $matchPost;
  1350. $line = $matchPost;
  1351. redo;
  1352. }
  1353. else
  1354. {
  1355. # Get the code before the comment
  1356. $blockCode .= $matchPre;
  1357. $blockAll .= $matchPre;
  1358. # Single line comment detected
  1359. $matchPost =~ s/\n//g;
  1360. $blockComment .= $matchStr . $matchPost;
  1361. $blockAll .= $matchStr . $matchPost;
  1362. }
  1363. }
  1364. else
  1365. {
  1366. $line =~ s/\n//g;
  1367. $blockCode .= $line;
  1368. $blockAll .= $line;
  1369. }
  1370. }
  1371. else
  1372. {
  1373. # Check multi line comment end
  1374. if ( $line =~ m/$regexpCommentMultiEnd/ )
  1375. {
  1376. my $matchPre = $`;
  1377. my $matchStr = $&;
  1378. my $matchPost = $';
  1379. # Get the code before the comment
  1380. $blockComment .= $matchPre . $matchStr;
  1381. $blockAll .= $matchPre . $matchStr;
  1382. $isInCode = 1;
  1383. # Process again the last fragment
  1384. $fileLines[$countLinesAll] = $matchPost;
  1385. $line = $matchPost;
  1386. redo;
  1387. }
  1388. else
  1389. {
  1390. $line =~ s/\n//g;
  1391. $blockComment .= $line;
  1392. $blockAll .= $line;
  1393. }
  1394. }
  1395. $blockCode .= "\n";
  1396. $blockComment .= "\n";
  1397. $blockAll .= "\n";
  1398. $countLinesAll++;
  1399. }
  1400. return ( $blockAll, $blockCode, $blockComment );
  1401. }
  1402. sub swiMatchPatternCount
  1403. {
  1404. my $text = shift();
  1405. my $pattern = shift();
  1406. my $count = 0;
  1407. while ( $text =~ m/$pattern/g )
  1408. {
  1409. $count++;
  1410. }
  1411. return $count;
  1412. }
  1413. sub swiMatchLinesCount
  1414. {
  1415. my @text = split( "\n", shift() );
  1416. my $pattern = shift();
  1417. my $count = 0;
  1418. foreach (@text)
  1419. {
  1420. if ( $_ =~ m/$pattern/ )
  1421. {
  1422. $count++;
  1423. }
  1424. }
  1425. return $count;
  1426. }
  1427. sub swiUtilArrayExtend
  1428. {
  1429. my $array = shift();
  1430. my $finalLength = shift();
  1431. my $emptySymbol = shift();
  1432. if ( $#{$array} > $finalLength )
  1433. {
  1434. DEBUG( "Length of array: " . $#{$array} );
  1435. DEBUG( "Requested final length: " . $finalLength );
  1436. DEBUG( Dumper($array) );
  1437. die('Internal Error occured!');
  1438. }
  1439. while ( $finalLength - $#{$array} > 0 )
  1440. {
  1441. push( @{$array}, $emptySymbol );
  1442. }
  1443. return @{$array};
  1444. }
  1445. sub swiUtilDirectoryCleanUp
  1446. {
  1447. my $dir = shift();
  1448. die("Internal error!") if not defined $dir;
  1449. die("Internal error!") if $dir eq "";
  1450. die("Internal error!") if $dir eq ".";
  1451. die("Internal error!") if $dir eq "./";
  1452. if ( opendir( DIR, $dir ) )
  1453. {
  1454. while ( my $file = readdir(DIR) )
  1455. {
  1456. unlink $dir . "/" . $file;
  1457. }
  1458. closedir(DIR);
  1459. }
  1460. }
  1461. sub swiUtil_Round
  1462. {
  1463. my $float = shift();
  1464. if ( ( $float - int($float) ) > 0.5 )
  1465. {
  1466. return int( $float + 1.0 );
  1467. }
  1468. else
  1469. {
  1470. return int($float);
  1471. }
  1472. }
  1473. return 1;