Processor.pm 58 KB

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