d1a67b9d |
1 | # This script provides commands for upgrade of OCCT and software based on it |
2 | # to a newer version of OCCT (7.0) |
3 | |
4 | |
5 | # source code for upgrading |
6 | set ArgName(HelpInfo) "h" |
7 | |
8 | set ArgName(SourceCode) "src" |
9 | set ArgName(IncPath) "inc" |
10 | |
11 | set ArgName(IncExtension) "incext" |
12 | set ArgName(SrcExtension) "srcext" |
13 | |
14 | set ArgName(RTTI) "rtti" |
15 | |
16 | set ArgName(CStyleCastHandle) "handlecast" |
17 | set ArgName(All) "all" |
18 | |
19 | set ArgName(Handle) "handle" |
20 | set ArgName(TCollection) "tcollection" |
21 | |
22 | set ArgName(CompatibleMode) "compat" |
23 | |
24 | set ArgName(Recurse) "recurse" |
25 | set ArgName(Rename) "rename" |
26 | |
27 | set ArgName(CheckOnly) "check" |
28 | set ArgName(WLog) "wlog" |
29 | set ArgName(Log) "log" |
30 | |
31 | proc HelpInformation {} { |
32 | global ArgName |
33 | global DataSectionName |
34 | |
35 | loginfo "Tool for upgrade of application code from older versions of OCCT." |
36 | loginfo "" |
37 | loginfo "Required parameter:" |
38 | loginfo " -$ArgName(SourceCode)=<path> - path to sources to upgrade" |
39 | loginfo "" |
40 | loginfo "File search options:" |
41 | loginfo " -$ArgName(IncPath)=<path> - path to header files of OCCT or other used libraries" |
42 | loginfo " -$ArgName(Recurse) - process all subfolders of '-$ArgName(SourceCode)' and '-$ArgName(IncPath)'" |
43 | loginfo " -$ArgName(SrcExtension)=cxx,cpp - extensions of source files" |
44 | loginfo " -$ArgName(IncExtension)=hxx,h,lxx,gxx - extensions of header files" |
45 | loginfo "" |
46 | loginfo "Upgrade options:" |
47 | loginfo " -$ArgName(All) - do all upgrades (if neither of below options are given)" |
48 | loginfo " -$ArgName(RTTI) - adapt code for changes in type system (RTTI) in OCCT 7.0" |
49 | loginfo " -$ArgName(Handle) - adapt code for changes in OCCT Handle" |
50 | loginfo " -$ArgName(TCollection) - replace forward declaration of TCollection classes by #include" |
51 | loginfo " -$ArgName(CStyleCastHandle) - replace c-style casts of Handle by DownCast()" |
52 | loginfo " -$ArgName(Rename) - apply renaming of classes" |
53 | loginfo "" |
54 | loginfo "Advanced options:" |
55 | loginfo " -$ArgName(CompatibleMode) - preserve old RTTI macros for compatability with OCCT 6.x" |
56 | loginfo " -$ArgName(CheckOnly) - do check only, no modifications will be made" |
57 | loginfo " -$ArgName(WLog) - show gui log of upgrade process" |
58 | loginfo " -$ArgName(Log)=<file path> - put the log into a file" |
59 | |
60 | return |
61 | } |
62 | |
63 | proc ParseArgs {theArgValues theArgs {theRemoveFromArgs "false"}} { |
64 | upvar $theArgValues anArgValues |
65 | |
66 | global ArgName |
67 | global DataSectionName |
68 | |
69 | # help information |
70 | set anArgValues(HelpInfo) [SeekArg $ArgName(HelpInfo) theArgs "false" $theRemoveFromArgs] |
71 | |
72 | # sources that will be upgraded |
73 | set anArgValues(SourceCode) [SeekArg $ArgName(SourceCode) theArgs "" $theRemoveFromArgs] |
74 | |
75 | set anArgValues(IncExtension) [SeekArg $ArgName(IncExtension) theArgs "h,hpp,hxx,gxx,lxx" $theRemoveFromArgs] |
76 | set anArgValues(SrcExtension) [SeekArg $ArgName(SrcExtension) theArgs "c,cpp,cxx" $theRemoveFromArgs] |
77 | |
78 | # inc folder |
79 | set anArgValues(IncPath) [SeekArg $ArgName(IncPath) theArgs "$anArgValues(SourceCode)" $theRemoveFromArgs] |
80 | |
81 | set anArgValues(RTTI) [SeekArg $ArgName(RTTI) theArgs "false" $theRemoveFromArgs] |
82 | set anArgValues(CStyleCastHandle) [SeekArg $ArgName(CStyleCastHandle) theArgs "false" $theRemoveFromArgs] |
83 | |
84 | set anArgValues(Handle) [SeekArg $ArgName(Handle) theArgs "false" $theRemoveFromArgs] |
85 | set anArgValues(TCollection) [SeekArg $ArgName(TCollection) theArgs "false" $theRemoveFromArgs] |
86 | |
87 | set anArgValues(Rename) [SeekArg $ArgName(Rename) theArgs "false" $theRemoveFromArgs] |
88 | |
89 | set aHasAgentArgs [expr {$anArgValues(RTTI) || $anArgValues(CStyleCastHandle) || \ |
90 | $anArgValues(Handle) || $anArgValues(TCollection)} || \ |
91 | $anArgValues(Rename)] |
92 | |
93 | set anArgValues(All) [SeekArg $ArgName(All) theArgs [expr {!$aHasAgentArgs}] $theRemoveFromArgs] |
94 | |
95 | set anArgValues(Recurse) [SeekArg $ArgName(Recurse) theArgs "false" $theRemoveFromArgs] |
96 | set anArgValues(CompatibleMode) [SeekArg $ArgName(CompatibleMode) theArgs "false" $theRemoveFromArgs] |
97 | set anArgValues(CheckOnly) [SeekArg $ArgName(CheckOnly) theArgs "false" $theRemoveFromArgs] |
98 | set anArgValues(WLog) [SeekArg $ArgName(WLog) theArgs "false" $theRemoveFromArgs] |
99 | |
100 | set anArgValues(Log) [SeekArg $ArgName(Log) theArgs "" $theRemoveFromArgs] |
101 | |
102 | return $theArgs |
103 | } |
104 | |
105 | proc SeekArg {theSoughtArgName theArgs {theDefaultArgValue ""} {theRemoveFromArgs false}} { |
106 | upvar ${theArgs} anArgs |
107 | |
108 | set aBooleanValue [string is boolean -strict $theDefaultArgValue] |
109 | |
110 | set anArgValues {} |
111 | |
112 | set anArgsIndex -1 |
113 | foreach anArg $anArgs { |
114 | incr anArgsIndex |
115 | |
116 | if {[regexp -- "-${theSoughtArgName}\=\(.\*\)" $anArg dummy anArgValue]} { |
117 | set anArgValue [regsub -all {\\} $anArgValue {/}] |
118 | if {$theRemoveFromArgs} { |
119 | set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex] |
120 | incr anArgsIndex -1 |
121 | } |
122 | if {"$anArgValue" != ""} { |
123 | lappend anArgValues $anArgValue |
124 | } else { |
125 | logwarn "'-${theSoughtArgName}' is skipped because it has empty value" |
126 | } |
127 | } elseif [string match "-${theSoughtArgName}" $anArg] { |
128 | if {$theRemoveFromArgs} { |
129 | set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex] |
130 | } |
131 | # skip non-boolean empty argument; do not break the foreach loop |
132 | if {$aBooleanValue} { |
133 | lappend anArgValues "true" |
134 | break |
135 | } else { |
136 | logwarn "'-${theSoughtArgName}' is skipped because it has empty value" |
137 | } |
138 | } |
139 | } |
140 | |
141 | # return boolean value as string |
142 | if {$aBooleanValue} { |
143 | if {[llength $anArgValues] > 0} { |
144 | return [lindex $anArgValues 0] |
145 | } else { |
146 | return $theDefaultArgValue |
147 | } |
148 | } |
149 | |
150 | if {[llength $anArgValues] == 0 && "$theDefaultArgValue" != ""} { |
151 | lappend anArgValues $theDefaultArgValue |
152 | } |
153 | |
154 | return $anArgValues |
155 | } |
156 | |
157 | # section names in the data file |
158 | set DataSectionName(TCollection) "tcollection" |
159 | set DataSectionName(Rename) "rename" |
160 | |
161 | proc DataFileName {} { |
162 | return [file join [file dirname [info script]] upgrade.dat] |
163 | } |
164 | |
165 | proc IsDataFileExist {} { |
166 | return [file exists [DataFileName]] |
167 | } |
168 | |
169 | proc ReadFromDataFile {theSectionName} { |
170 | if {![file exists [DataFileName]]} { |
171 | return |
172 | } |
173 | |
174 | set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL] |
175 | |
176 | set aSectionValueList {} |
177 | |
178 | set anIsSection false |
179 | set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+} |
180 | foreach aLine $aFileContent { |
181 | if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} { |
182 | if {"$aSectionName" == "$theSectionName"} { |
183 | set anIsSection true |
184 | continue |
185 | } elseif {$anIsSection == true} { |
186 | set anIsSection false |
187 | break |
188 | } |
189 | } |
190 | |
191 | if {$anIsSection == true} { |
192 | set aTrimmedLine [string trimright $aLine] |
193 | if {"$aTrimmedLine" != ""} { |
194 | lappend aSectionValueList $aTrimmedLine |
195 | } |
196 | } |
197 | } |
198 | |
199 | return $aSectionValueList |
200 | } |
201 | |
202 | proc SaveToDataFile {theSectionName theSectionContent} { |
203 | if {![file exists [DataFileName]]} { |
204 | return |
205 | } |
206 | |
207 | set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL] |
208 | |
209 | set aLinesBefore {} |
210 | set aLinesAfter {} |
211 | |
212 | set anIsSection false |
213 | set anIsSectionBefore true |
214 | set anIsSectionAfter false |
215 | |
216 | set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+} |
217 | foreach aLine $aFileContent { |
218 | if {$anIsSectionBefore} { |
219 | lappend aLinesBefore $aLine |
220 | } |
221 | |
222 | if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} { |
223 | if {"$aSectionName" == "$theSectionName"} { |
224 | set anIsSectionBefore false |
225 | set anIsSection true |
226 | } elseif {$anIsSection == true} { |
227 | set anIsSection false |
228 | set anIsSectionAfter true |
229 | } |
230 | } |
231 | |
232 | if {$anIsSection == true} { |
233 | continue |
234 | } |
235 | |
236 | if {$anIsSectionAfter} { |
237 | lappend aLinesAfter $aLine |
238 | } |
239 | } |
240 | |
241 | # write to file |
242 | SaveListToFile [DataFileName] [list {*}$aLinesBefore {*}$theSectionContent {*}$aLinesAfter] $aDataEOL |
243 | } |
244 | |
245 | # Main tool, accepts path to location of source tree to be upgraded. |
246 | proc upgrade {args} { |
247 | |
248 | global ArgName |
249 | global LogFilePath |
250 | global DataSectionName |
251 | |
252 | set theArgs $args |
253 | set anUnparsedArgs [ParseArgs anArgValues $theArgs "true"] |
254 | |
255 | if {"$anUnparsedArgs" != ""} { |
256 | logerr "undefined arguments: $anUnparsedArgs" |
257 | loginfo "use -$ArgName(HelpInfo) to show all the arguments" |
258 | return |
259 | } |
260 | |
261 | if {$anArgValues(HelpInfo) || [llength $anArgValues(SourceCode)] == 0} { |
262 | HelpInformation |
263 | return |
264 | } |
265 | |
266 | if {"$anArgValues(Log)" != ""} { |
267 | set LogFilePath $anArgValues(Log) |
268 | |
269 | # clean file before writing |
270 | if {[file exists "$LogFilePath"]} { |
271 | set fd [open "$LogFilePath" r+] |
272 | chan truncate $fd 0 |
273 | close $fd |
274 | } |
275 | } |
276 | |
277 | if {$anArgValues(WLog)} { |
278 | _create_logger |
279 | } |
280 | |
281 | # collect src directory structure (all subdirs) |
282 | set anIncPaths {} |
283 | foreach aSrcDir $anArgValues(SourceCode) { |
284 | lappend anIncPaths $aSrcDir |
285 | foreach aSubSrcDir [CollectDirStructure $aSrcDir] { |
286 | lappend anIncPaths $aSubSrcDir |
287 | } |
288 | } |
289 | |
290 | foreach anIncDir $anArgValues(IncPath) { |
291 | lappend anIncPaths $anIncDir |
292 | foreach aSubIncDir [CollectDirStructure $anIncDir] { |
293 | lappend anIncPaths $aSubIncDir |
294 | } |
295 | } |
296 | |
297 | set anIncPaths [lsort -unique -dictionary $anIncPaths] |
298 | # end the collect |
299 | |
300 | set aRawNewNames [ReadFromDataFile $DataSectionName(Rename)] |
301 | foreach aRawName $aRawNewNames { |
302 | set aRawName [split $aRawName " "] |
303 | if {[llength $aRawName] > 1} { |
304 | # set aNewNames (old name) [new name] |
305 | set aNewNames([lindex ${aRawName} 0]) [lindex ${aRawName} 1] |
306 | } |
307 | } |
308 | |
309 | set aDoRename true |
310 | if {[llength [array names aNewNames]] == 0} { |
311 | set aDoRename false |
312 | |
313 | logwarn "renaming skipped. there is no class names to rename" |
314 | logwarn "see the content of [DataFileName] file, $DataSectionName(Rename) section" |
315 | } |
316 | |
317 | set aProcNameWithArgs "[lindex [info level 0] 0]" |
318 | foreach anArgName [array names anArgValues] { |
319 | if [string is boolean -strict $anArgValues($anArgName)] { |
320 | if [string is true "$anArgValues($anArgName)"] { |
321 | set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)"] |
322 | } |
323 | } else { |
324 | set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)=$anArgValues($anArgName)"] |
325 | } |
326 | } |
327 | |
328 | loginfo "$aProcNameWithArgs" |
329 | |
330 | # merge all processed extensions |
331 | set anExtensions "$anArgValues(SrcExtension),$anArgValues(IncExtension)" |
332 | |
333 | set aSourceCodePaths $anArgValues(SourceCode) |
334 | while {[llength $aSourceCodePaths]} { |
335 | set aSourceCodePaths [lassign $aSourceCodePaths aProcessedPath] |
336 | |
337 | loginfo "Processing: $aProcessedPath" |
338 | |
339 | if {$anArgValues(All) || $anArgValues(RTTI)} { |
340 | ConvertRtti $aProcessedPath \ |
341 | $anIncPaths \ |
342 | $anArgValues(CheckOnly) \ |
343 | $anArgValues(CompatibleMode) \ |
344 | $anArgValues(IncExtension) \ |
345 | $anArgValues(SrcExtension) |
346 | } |
347 | |
348 | if {$anArgValues(All) || $anArgValues(Handle)} { |
349 | ConvertHandle $aProcessedPath $anIncPaths $anArgValues(CheckOnly) $anExtensions |
350 | } |
351 | |
352 | if {$anArgValues(All) || $anArgValues(TCollection)} { |
353 | ConvertTColFwd $aProcessedPath $anArgValues(IncExtension) |
354 | } |
355 | |
356 | if {$anArgValues(All) || $anArgValues(CStyleCastHandle)} { |
357 | ConvertCStyleHandleCast $aProcessedPath $anExtensions $anArgValues(CheckOnly) |
358 | } |
359 | |
360 | if {$anArgValues(All) || $anArgValues(Rename)} { |
361 | if {$aDoRename} { |
362 | Rename $aProcessedPath $anExtensions aNewNames $anArgValues(CheckOnly) |
363 | } |
364 | } |
365 | |
366 | # Recurse processing |
367 | if {$anArgValues(Recurse)} { |
368 | lappend aSourceCodePaths {*}[glob -nocomplain -directory $aProcessedPath -type d *] |
369 | } |
370 | } |
371 | } |
372 | |
373 | # search and rename the indeces (old names) of @theNewNames with their values (new ones) |
374 | # processes files that have @theExtensions only in @thePath folder |
375 | proc Rename {thePath theExtensions theNewNames theCheckMode} { |
376 | upvar $theNewNames aNewNames |
377 | |
378 | set aNames [array names aNewNames] |
379 | |
380 | foreach aFile [glob -nocomplain -type f -directory $thePath *.{$theExtensions}] { |
381 | # loginfo "$aFile processing" |
382 | set aFileContent [ReadFileToRawText $aFile] |
383 | |
384 | set aHasChanges false |
385 | foreach aName $aNames { |
386 | set anIndexInRow 0 |
387 | set aClassNameTmpl "\\m$aName\\M" |
388 | while { [regexp -start $anIndexInRow -indices -lineanchor $aClassNameTmpl $aFileContent aFoundClassNameLoc] } { |
389 | set anIndexInRow [lindex $aFoundClassNameLoc 1] |
390 | |
391 | if {$theCheckMode} { |
392 | logwarn "Warning: $aFile contains $aName" |
393 | break |
394 | } else { |
395 | set aHasChanges true |
396 | ReplaceSubString aFileContent $aFoundClassNameLoc "$aNewNames($aName)" anIndexInRow |
397 | incr anIndexInRow -1 |
398 | } |
399 | } |
400 | } |
401 | |
402 | if {$aHasChanges} { |
403 | SaveTextToFile $aFile $aFileContent |
404 | } |
405 | } |
406 | } |
407 | |
408 | # @thePackagePath eather file or folder. If it is a folder, |
409 | # all files with @theHeaderExtensions are processed. |
410 | # "fwd.tcollection" section from upgrade.ini file is used to find out what |
411 | # classes have been converted and, thus, what forward declarations can be replaced |
412 | proc ConvertTColFwd {thePackagePath theHeaderExtensions} { |
413 | global DataSectionName |
414 | |
415 | # Note: the content of theHeaderExtensions should have |
416 | # further form (values separated by comma): "ext1,ext2,ext3" |
417 | # this form will be used below in reg expression to collect all header files |
418 | |
419 | if {! [file exists $thePackagePath]} { |
420 | logerr "Error: $thePackagePath does not exist" |
421 | return |
422 | } |
423 | |
424 | # read the list of already converted TCollection classes |
425 | if [IsDataFileExist] { |
426 | set aConvertedTColClasses [ReadFromDataFile $DataSectionName(TCollection)] |
427 | } else { |
428 | logerr "[DataFileName] file of upgrade process does not exist" |
429 | return |
430 | } |
431 | |
432 | # pattern that will be used |
433 | set aForwardDeclPattern {^ *class *([A-Za-z0-9_/\.]+) *;} |
434 | |
435 | set aTargetPaths ${thePackagePath} |
436 | while {[llength $aTargetPaths]} { |
437 | set aTargetPaths [lassign $aTargetPaths aProcessedPath] |
438 | |
439 | # if aProcessedPath is a folder, collect all files with $theHeaderExtensions from it |
440 | set aProcessedHeaders ${aProcessedPath} |
441 | if {[file isdirectory $aProcessedPath]} { |
442 | # get all header files |
443 | set aProcessedHeaders [glob -nocomplain -type f -directory $aProcessedPath *.{$theHeaderExtensions}] |
444 | } |
445 | |
446 | foreach aHeader $aProcessedHeaders { |
447 | set aHeaderLineIndex -1 |
448 | set aHeaderContentUpdated false |
449 | |
450 | # read the content of the header file |
451 | set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL] |
452 | |
453 | # remove _isMulti variable that used in _check_line |
454 | set _isMulti false |
455 | |
456 | foreach aHeaderContentLine $aHeaderContent { |
457 | incr aHeaderLineIndex |
458 | |
459 | # remove _cmnt variable that used in _check_line |
460 | set _cmnt "" |
461 | |
462 | set aHeaderContentLine [_check_line $aHeaderContentLine] |
463 | if {[regexp {^ *class *([A-Za-z0-9_/\.]+) *;} $aHeaderContentLine dummy aForwardDeclClass]} { |
464 | if {[lsearch $aConvertedTColClasses $aForwardDeclClass] != -1} { |
465 | set aHeaderContentUpdated true |
466 | set aHeaderContentRow "\#include <$aForwardDeclClass.hxx>" |
467 | set aHeaderContent [lreplace $aHeaderContent $aHeaderLineIndex $aHeaderLineIndex $aHeaderContentRow] |
468 | } |
469 | } |
470 | } |
471 | |
472 | if {$aHeaderContentUpdated} { |
473 | loginfo "$aHeader updated" |
474 | SaveListToFile $aHeader $aHeaderContent $aHeaderEOL |
475 | } |
476 | } |
477 | } |
478 | } |
479 | |
f5f4ebd0 |
480 | # try to find source file corresponding to the specified header and either |
481 | # inject macro IMPLEMENT_STANDARD_RTTIEXT in it, or check it already present, |
482 | # and depending on this, return suffix to be used for corresponding macro |
483 | # DEFINE_STANDARD_RTTI... (either inline or out-of-line variant) |
484 | proc DefineExplicitRtti {hxxfile class base theSourceExtensions} { |
485 | # if current file is not a header (by extension), exit with "inline" variant |
486 | # (there is no need to bother with out-of-line instantiations for local class) |
487 | set ext [string range [file extension $hxxfile] 1 end] |
488 | if { [lsearch -exact [split $theSourceExtensions ,] $ext] >=0 } { |
489 | return "_INLINE" |
490 | } |
491 | |
492 | # try to find source file with the same name but source-type extension |
493 | # in the same folder |
494 | set filename [file rootname $hxxfile] |
495 | foreach ext [split $theSourceExtensions ,] { |
496 | # puts "Checking ${filename}.$ext" |
497 | if { ! [file readable ${filename}.$ext] } { continue } |
498 | |
499 | # check the file content |
500 | set aFileContent [ReadFileToList ${filename}.$ext aFileRawContent aEOL] |
501 | |
502 | # try to find existing macro IMPLEMENT_STANDARD_RTTIEXT and check that |
503 | # it is consistent |
504 | foreach line $aFileContent { |
505 | if { [regexp "^\\s*IMPLEMENT_STANDARD_RTTIEXT\\s*\\(\\s*$class\\s*,\\s*(\[A-Za-z0-9_\]+)\\s*\\)" $line res impl_base] } { |
506 | # implementation is in place, just report warning if second argument |
507 | # is different |
508 | if { $base != $impl_base } { |
509 | logwarn "Warning in ${filename}.$ext: second argument of macro" |
510 | logwarn " IMPLEMENT_STANDARD_RTTIEXT($class,$impl_base)" |
511 | logwarn " is not the same as detected base class, $base" |
512 | } |
513 | return "EXT" |
514 | } |
515 | } |
516 | |
517 | # inject a new macro before the first non-empty, non-comment, and |
518 | # non-preprocessor line |
519 | set aNewFileContent {} |
520 | set injected 0 |
521 | set inc_found 0 |
522 | foreach line $aFileContent { |
523 | if { ! $injected } { |
524 | # add macro before first non-empty line after #includes |
525 | if { [regexp {^\s*$} $line] } { |
526 | } elseif { [regexp {^\s*\#\s*include} $line] } { |
527 | set inc_found 1 |
528 | } elseif { $inc_found } { |
529 | set injected 1 |
530 | lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)" |
531 | if { ! [regexp "^IMPLEMENT_" $line] } { |
532 | lappend aNewFileContent "" |
533 | } |
534 | } |
535 | } |
536 | lappend aNewFileContent $line |
537 | } |
538 | if { ! $injected } { |
539 | lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)" |
540 | } |
541 | SaveListToFile ${filename}.$ext $aNewFileContent $aEOL |
542 | |
543 | return "EXT" |
544 | } |
545 | |
546 | logwarn "Warning in ${hxxfile}: cannot find corresponding source file," |
547 | logwarn " will use inline version of DEFINE_STANDARD_RTTI" |
548 | return "_INLINE" |
549 | } |
550 | |
d1a67b9d |
551 | # Parse source files and: |
552 | # |
553 | # - add second argument to macro DEFINE_STANDARD_RTTI specifying first base |
554 | # class found in the class declaration; |
555 | # - replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx; |
556 | # - add #includes for all classes used as argument to macro |
557 | # STANDARD_TYPE(), except of already included ones |
558 | # |
559 | # If theCompatibleMode is false, in addition: |
560 | # - removes macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*(); |
561 | proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ |
562 | theHeaderExtensions theSourceExtensions} { |
563 | |
564 | # iterate by header and source files |
565 | foreach aProcessedFile [glob -nocomplain -type f -directory $theProcessedPath *.{$theHeaderExtensions,$theSourceExtensions}] { |
566 | set aProcessedFileName [file tail $aProcessedFile] |
567 | |
568 | set aProcessedFileContent [ReadFileToRawText $aProcessedFile] |
569 | |
570 | # find all declarations of classes with public base in this header file; |
571 | # the result is stored in array inherits(class) |
572 | set index 0 |
573 | array unset inherits |
574 | set pattern_class {^\s*class\s+([A-Za-z_0-9:]+)\s*:\s*public\s+([A-Za-z_0-9:]+)\s*([,]?)} |
575 | while {[regexp -start $index -indices -lineanchor $pattern_class $aProcessedFileContent location class base comma]} { |
576 | set index [lindex $location 1] |
577 | |
578 | set class [eval string range \$aProcessedFileContent $class] |
579 | set base [eval string range \$aProcessedFileContent $base] |
580 | |
581 | if { [info exists inherits($class)] } { |
582 | set inherits($class,multiple) "found multiple declarations of class $class" |
583 | } else { |
584 | if { [lindex $comma 0] <= [lindex $comma 1] } { |
585 | set inherits($class,multiple) "class $class uses multiple inheritance" |
586 | } |
587 | set inherits($class) $base |
588 | } |
589 | } |
590 | |
591 | set change_flag 0 |
592 | |
593 | # find all instances of DEFINE_STANDARD_RTTI with single or two arguments |
594 | set index 0 |
f5f4ebd0 |
595 | set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI)([_A-Z]+)?\s*\(\s*([A-Za-z_0-9,\s]+)\s*\)} |
d1a67b9d |
596 | while { [regexp -start $index -indices -lineanchor $pattern_rtti \ |
f5f4ebd0 |
597 | $aProcessedFileContent location start suffix clist] } { |
d1a67b9d |
598 | set index [lindex $location 1] |
599 | |
f5f4ebd0 |
600 | set start [eval string range \$aProcessedFileContent $start] |
601 | set suffix [eval string range \$aProcessedFileContent $suffix] |
602 | set clist [split [eval string range \$aProcessedFileContent $clist] ,] |
d1a67b9d |
603 | |
604 | if { [llength $clist] == 1 } { |
605 | set class [string trim [lindex $clist 0]] |
606 | if { [info exists inherits($class)] } { |
607 | if { ! $theCheckMode } { |
608 | if { [info exists inherits($class,multiple)] } { |
609 | logwarn "Warning in $aProcessedFileName: $inherits($class,multiple);" |
610 | logwarn "macro DEFINE_STANDARD_RTTI is changed assuming it inherits $inherits($class), please check!" |
611 | } |
612 | set change_flag 1 |
f5f4ebd0 |
613 | ReplaceSubString aProcessedFileContent $location \ |
614 | "${start}EXT($class,$inherits($class))" index |
d1a67b9d |
615 | } |
616 | } else { |
617 | logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix" |
618 | } |
619 | } elseif { [llength $clist] == 2 } { |
620 | set class [string trim [lindex $clist 0]] |
621 | set base [string trim [lindex $clist 1]] |
622 | if { ! [info exists inherits($class)] } { |
623 | logwarn "Warning in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file" |
f5f4ebd0 |
624 | } elseif { $base != $inherits($class) && ! [info exists inherits($class,multiple)] } { |
d1a67b9d |
625 | logwarn "Warning in $aProcessedFile: Second argument in macro DEFINE_STANDARD_RTTI for class $class is $base while $class seems to inherit from $inherits($class)" |
f5f4ebd0 |
626 | } |
627 | # convert intermediate version of macro DEFINE_STANDARD_RTTI |
628 | # with two arguments to either _INLINE or EXT variant |
629 | if { ! $theCheckMode && "$suffix" == "" } { |
630 | set change_flag 1 |
631 | # try to inject macro IMPLEMENT_STANDARD_RTTIEXT in the |
632 | # corresponding source file (or check it already present), |
633 | # and depending on this, use either inline or out-of-line variant |
634 | set rtti_suffix [DefineExplicitRtti $aProcessedFile $class $base $theSourceExtensions] |
635 | ReplaceSubString aProcessedFileContent $location \ |
636 | "${start}${rtti_suffix}($class,$base)" index |
d1a67b9d |
637 | } |
638 | } |
639 | } |
640 | |
641 | # replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx |
642 | # set index 0 |
643 | # set pattern_definehandle {\#\s*include\s*<\s*Standard_DefineHandle.hxx\s*>} |
644 | # while { [regexp -start $index -indices -lineanchor $pattern_definehandle $aProcessedFileContent location] } { |
645 | # set index [lindex $location 1] |
646 | # if { ! $theCheckMode } { |
647 | # set change_flag 1 |
648 | # ReplaceSubString aProcessedFileContent $location "\#include <Standard_Type.hxx>" index |
649 | # incr index -1 |
650 | # } else { |
651 | # logwarn "Warning: $aProcessedFile contains obsolete forward declarations of Handle classes" |
652 | # break |
653 | # } |
654 | # } |
655 | |
656 | # remove macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*(); |
657 | if { ! $theCompatibleMode } { |
658 | set index 0 |
659 | set first_newline \n\n |
660 | set pattern_implement {\\?\n\s*IMPLEMENT_(DOWNCAST|STANDARD_[A-Z_]+|HARRAY1|HARRAY2|HUBTREE|HEBTREE|HSEQUENCE)\s*\([A-Za-z0-9_ ,]*\)\s*;?} |
f5f4ebd0 |
661 | while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location macro] } { |
d1a67b9d |
662 | set index [lindex $location 1] |
f5f4ebd0 |
663 | # macro IMPLEMENT_STANDARD_RTTIEXT is retained |
664 | if { [eval string range \$aProcessedFileContent $macro] == "STANDARD_RTTIEXT" } { |
665 | continue |
666 | } |
d1a67b9d |
667 | if { ! $theCheckMode } { |
668 | set change_flag 1 |
669 | ReplaceSubString aProcessedFileContent $location $first_newline index |
670 | # set first_newline "" |
671 | incr index -1 |
672 | } else { |
673 | logwarn "Warning: $aProcessedFile contains deprecated macros IMPLEMENT_*" |
674 | break |
675 | } |
676 | } |
677 | } |
678 | |
679 | # find all uses of macro STANDARD_TYPE and method DownCast and ensure that |
680 | # argument class is explicitly included |
f5f4ebd0 |
681 | set pattern_incbeg {\s*#\s*include\s*[\"<]\s*([A-Za-z0-9_/]*/)?} |
d1a67b9d |
682 | set pattern_incend {[.][a-zA-Z]+\s*[\">]} |
683 | set index 0 |
684 | set addtype {} |
685 | set pattern_type1 {STANDARD_TYPE\s*\(\s*([A-Za-z0-9_]+)\s*\)} |
686 | while { [regexp -start $index -indices $pattern_type1 $aProcessedFileContent location name] } { |
687 | set index [lindex $location 1] |
688 | set name [eval string range \$aProcessedFileContent $name] |
689 | if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] && |
690 | [lsearch -exact $addtype $name] < 0 && |
691 | [SearchForFile $theIncPaths $name.hxx]} { |
692 | lappend addtype $name |
693 | } |
694 | } |
695 | set pattern_type2 {Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*::\s*DownCast} |
696 | while { [regexp -start $index -indices $pattern_type2 $aProcessedFileContent location name] } { |
697 | set index [lindex $location 1] |
698 | set name [eval string range \$aProcessedFileContent $name] |
699 | if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] && |
700 | [lsearch -exact $addtype $name] < 0 && |
701 | [SearchForFile $theIncPaths $name.hxx]} { |
702 | lappend addtype $name |
703 | } |
704 | } |
705 | if { [llength $addtype] > 0 } { |
706 | if { ! $theCheckMode } { |
707 | set addinc "" |
708 | foreach type $addtype { |
f5f4ebd0 |
709 | if { "$aProcessedFileName" != "$type.hxx" } { |
710 | append addinc "\n#include <$type.hxx>" |
711 | } |
d1a67b9d |
712 | } |
713 | if { [regexp -indices ".*\n${pattern_incbeg}\[A-Za-z0-9_/\]+${pattern_incend}" $aProcessedFileContent location] } { |
714 | set change_flag 1 |
715 | ReplaceSubString aProcessedFileContent $location "[eval string range \$aProcessedFileContent $location]$addinc" index |
716 | } else { |
717 | logerr "Error: $aProcessedFile: Cannot find #include statement to add more includes..." |
718 | } |
719 | } else { |
720 | logwarn "Warning: $aProcessedFile: The following class names are used as arguments of STANDARD_TYPE" |
721 | logwarn " macro, but not included directly: $addtype" |
722 | break |
723 | } |
724 | } |
725 | |
726 | # apply changes to the header file |
727 | if { $change_flag } { |
728 | SaveTextToFile $aProcessedFile $aProcessedFileContent |
729 | } |
730 | } |
731 | } |
732 | |
733 | # replace all forward declarations of "class Handle(...)" with fwd of "class ..." |
734 | proc ConvertHandle {theTargetPath theIncPaths theCheckMode theExtensions} { |
735 | |
736 | # iterate by header files |
737 | foreach aHeader [glob -nocomplain -type f -directory $theTargetPath *.{$theExtensions}] { |
f5f4ebd0 |
738 | set aCurrentHeaderName [file tail $aHeader] |
d1a67b9d |
739 | |
740 | # skip gxx files, as names Handle_xxx used there are in most cases |
741 | # placeholders of the argument types substituted by #define |
742 | if {[file extension $aHeader] == ".gxx"} { |
743 | continue |
744 | } |
745 | |
746 | # read the content of the header |
747 | if { [catch {set fd [open $aHeader rb]}] } { |
748 | logerr "Error: cannot open $aHeader" |
749 | continue |
750 | } |
751 | close $fd |
752 | |
753 | set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL] |
754 | |
755 | set anUpdateHeader false |
756 | |
757 | # if file contains "slots:" or "signals:", assume it defines some QObject |
758 | # class(es). |
759 | # In this case, type names "Handle_T" will not be replaced by Handle(T) to |
760 | # prevent failure of compilation of MOC code if such types are used in |
761 | # slots or signals (MOC does not expand macros). |
762 | # Forward declaration of a Handle will be then replaced by #include of |
763 | # corresponding class header (if such header is found), assuming that name |
764 | # typedefed Handle_T is defined in corresponding header (as typedef). |
765 | set isQObject [expr [regexp "Q_OBJECT" $aHeaderContent] && [regexp "(slots|signals)\s*:" $aHeaderContent]] |
766 | |
767 | # replace all IDs with prefix Handle_ by use of Handle() macro |
768 | if { ! $isQObject } { |
769 | set anUpdatedHeaderContent {} |
770 | set pattern_handle {\mHandle_([A-Za-z0-9_]+)} |
771 | foreach line $aHeaderContent { |
f5f4ebd0 |
772 | # do not touch typedefs, #include, and #if... statements |
773 | if { [regexp {^\s*typedef} $line] || |
774 | [regexp {^\s*\#\s*include} $line] || [regexp {^\s*\#\s*if} $line] } { |
d1a67b9d |
775 | lappend anUpdatedHeaderContent $line |
776 | continue |
777 | } |
778 | |
779 | # in other preprocessor statements, skip first expression to avoid |
780 | # replacements in #define Handle_... and similar cases |
781 | set index 0 |
782 | if { [regexp -indices {\s*#\s*[A-Za-z]+\s+[^\s]+} $line location] } { |
783 | set index [expr 1 + [lindex $location 1]] |
784 | } |
785 | |
786 | # replace Handle_T by Handle(T) |
787 | while { [regexp -start $index -indices $pattern_handle $line location class] } { |
788 | set index [lindex $location 1] |
789 | |
790 | set class [eval string range \$line $class] |
791 | # puts "Found: [eval string range \$line $location]" |
792 | |
793 | if { ! $theCheckMode } { |
794 | set anUpdateHeader true |
795 | ReplaceSubString line $location "Handle($class)" index |
796 | } else { |
797 | logwarn "Warning: $aHeader refers to IDs starting with \"Handle_\" which are likely" |
798 | logwarn " instances of OCCT Handle classes (e.g. \"$class\"); these are to be " |
799 | logwarn " replaced by template opencascade::handle<> or legacy macro Handle()" |
800 | set index -1 ;# to break outer cycle |
801 | break |
802 | } |
803 | } |
804 | lappend anUpdatedHeaderContent $line |
805 | |
806 | if { $index < 0 } { |
807 | set anUpdatedHeaderContent $aHeaderContent |
808 | break |
809 | } |
810 | } |
811 | set aHeaderContent $anUpdatedHeaderContent |
812 | } |
813 | |
814 | # replace NS::Handle(A) by Handle(NS::A) |
815 | set anUpdatedHeaderContent {} |
816 | set pattern_nshandle {([A-Za-z0-9_]+)\s*::\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)} |
817 | foreach line $aHeaderContent { |
818 | set index 0 |
819 | |
820 | while { [regexp -start $index -indices -lineanchor $pattern_nshandle $line location scope class]} { |
821 | set index [lindex $location 1] |
822 | |
823 | set scope [eval string range \$line $scope] |
824 | set class [eval string range \$line $class] |
825 | |
826 | if { ! $theCheckMode } { |
827 | set anUpdateHeader true |
828 | ReplaceSubString line $location "Handle(${scope}::${class})" index |
829 | } else { |
830 | logwarn "Warning in $aHeader: usage of Handle macro inside scope is incorrect: [eval string range \$line $location]" |
831 | set index -1 ;# to break outer cycle |
832 | break |
833 | } |
834 | } |
835 | lappend anUpdatedHeaderContent $line |
836 | |
837 | if { $index < 0 } { |
838 | set anUpdatedHeaderContent $aHeaderContent |
839 | break |
840 | } |
841 | } |
842 | set aHeaderContent $anUpdatedHeaderContent |
843 | |
844 | # remove all forward declarations of Handle classes |
845 | set anUpdatedHeaderContent {} |
846 | set aFwdHandlePattern {^\s*class\s+Handle[_\(]([A-Za-z0-9_]+)[\)]?\s*\;\s*$} |
847 | foreach aHeaderContentLine $aHeaderContent { |
848 | if {[regexp $aFwdHandlePattern $aHeaderContentLine dummy aForwardDeclHandledClass]} { |
849 | if {$theCheckMode} { |
850 | loginfo "Info: $aHeader contains statement involving forward decl of Handle_$aForwardDeclHandledClass" |
851 | } else { |
852 | # replace by forward declaration of a class or its include unless |
853 | # it is already declared or included |
f5f4ebd0 |
854 | if { ! [regexp "\#\\s*include\\s*\[\<\"\]\\s*(\[A-Za-z0-9_/\]*/)?$aForwardDeclHandledClass\[.\]hxx\\s*\[\>\"\]" $aHeaderContent] } { |
855 | if { $isQObject && "$aCurrentHeaderName" != "${aForwardDeclHandledClass}.hxx" } { |
d1a67b9d |
856 | lappend anUpdatedHeaderContent "#include <${aForwardDeclHandledClass}.hxx>" |
857 | if { ! [SearchForFile $theIncPaths ${aForwardDeclHandledClass}.hxx] } { |
858 | loginfo "Warning: include ${aForwardDeclHandledClass}.hxx added in $aHeader, assuming it exists and defines Handle_$aForwardDeclHandledClass" |
859 | } |
860 | } elseif { ! [regexp "^\s*class\s+$aForwardDeclHandledClass\s*;" $aHeaderContent] } { |
861 | lappend anUpdatedHeaderContent "class $aForwardDeclHandledClass;" |
862 | } |
863 | } |
864 | set anUpdateHeader true |
865 | continue |
866 | } |
867 | } |
868 | lappend anUpdatedHeaderContent $aHeaderContentLine |
869 | } |
870 | set aHeaderContent $anUpdatedHeaderContent |
871 | |
872 | # remove all typedefs using Handle() macro to generate typedefed name |
873 | set anUpdatedHeaderContent {} |
874 | set aTypedefHandlePattern {^\s*typedef\s+[_A-Za-z\<\>, \s]+\s+Handle\([A-Za-z0-9_]+\)\s*\;\s*$} |
875 | foreach aHeaderContentLine $aHeaderContent { |
876 | if {[regexp $aTypedefHandlePattern $aHeaderContentLine aFoundPattern]} { |
877 | if {$theCheckMode} { |
878 | loginfo "Info: $aHeader contains typedef using Handle macro to generate name: $aFoundPattern" |
879 | } else { |
880 | set anUpdateHeader true |
881 | continue |
882 | } |
883 | } |
884 | lappend anUpdatedHeaderContent $aHeaderContentLine |
885 | } |
886 | set aHeaderContent $anUpdatedHeaderContent |
887 | |
888 | # remove all #include statements for files starting with "Handle_" |
889 | set anUpdatedHeaderContent {} |
890 | set anIncHandlePattern {^\s*\#\s*include\s+[\<\"]\s*(Handle[\(_][A-Za-z0-9_.]+[\)]?)\s*[\>\"]\s*$} |
891 | foreach aHeaderContentLine $aHeaderContent { |
892 | if {[regexp $anIncHandlePattern $aHeaderContentLine aFoundPattern anHxxName] && |
893 | ! [SearchForFile $theIncPaths $anHxxName]} { |
894 | if {$theCheckMode} { |
895 | loginfo "Info: $aHeader includes missing header: $anHxxName" |
896 | } else { |
897 | set anUpdateHeader true |
898 | continue |
899 | } |
900 | } |
901 | lappend anUpdatedHeaderContent $aHeaderContentLine |
902 | } |
903 | |
904 | # save result |
905 | if {$anUpdateHeader} { |
906 | SaveListToFile $aHeader $anUpdatedHeaderContent $aHeaderEOL |
907 | } |
908 | } |
909 | } |
910 | |
911 | # Replaces C-style casts of Handle object to Handle to derived type |
912 | # by call to DownCast() method |
913 | proc ConvertCStyleHandleCast {pkpath theExtensions theCheckMode} { |
914 | |
915 | # iterate by header files |
916 | foreach afile [glob -nocomplain -type f -directory $pkpath *.\{$theExtensions\}] { |
917 | set hxx [ReadFileToRawText $afile] |
918 | |
919 | set change_flag 0 |
920 | |
921 | # replace ((Handle(A)&)b) by Handle(A)::DownCast(b) |
922 | set index 0 |
923 | set pattern_refcast1 {\(\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)\)} |
924 | while { [regexp -start $index -indices -lineanchor $pattern_refcast1 $hxx location class var]} { |
925 | set index [lindex $location 1] |
926 | |
927 | set class [eval string range \$hxx $class] |
928 | set var [eval string range \$hxx $var] |
929 | |
930 | if { ! $theCheckMode } { |
931 | set change_flag 1 |
932 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index |
933 | } else { |
934 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
935 | } |
936 | } |
937 | |
938 | # replace (Handle(A)&)b, by Handle(A)::DownCast(b), |
939 | # replace (Handle(A)&)b; by Handle(A)::DownCast(b); |
940 | # replace (Handle(A)&)b) by Handle(A)::DownCast(b)) |
941 | set index 0 |
942 | set pattern_refcast2 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)(\s*[,;\)])} |
943 | while { [regexp -start $index -indices -lineanchor $pattern_refcast2 $hxx location class var end]} { |
944 | set index [lindex $location 1] |
945 | |
946 | set class [eval string range \$hxx $class] |
947 | set var [eval string range \$hxx $var] |
948 | set end [eval string range \$hxx $end] |
949 | |
950 | if { ! $theCheckMode } { |
951 | set change_flag 1 |
952 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index |
953 | } else { |
954 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
955 | } |
956 | } |
957 | |
958 | # replace (*((Handle(A)*)&b)) by Handle(A)::DownCast(b) |
959 | set index 0 |
960 | set pattern_ptrcast1 {([^A-Za-z0-9_]\s*)\(\s*[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)\s*\)} |
961 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast1 $hxx location start class var] } { |
962 | set index [lindex $location 1] |
963 | |
964 | set start [eval string range \$hxx $start] |
965 | set class [eval string range \$hxx $class] |
966 | set var [eval string range \$hxx $var] |
967 | |
968 | if { ! $theCheckMode } { |
969 | set change_flag 1 |
970 | ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index |
971 | } else { |
972 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
973 | } |
974 | } |
975 | |
976 | # replace *((Handle(A)*)&b) by Handle(A)::DownCast(b) |
977 | set index 0 |
978 | set pattern_ptrcast2 {[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)} |
979 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast2 $hxx location class var] } { |
980 | set index [lindex $location 1] |
981 | |
982 | set class [eval string range \$hxx $class] |
983 | set var [eval string range \$hxx $var] |
984 | |
985 | if { ! $theCheckMode } { |
986 | set change_flag 1 |
987 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index |
988 | } else { |
989 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
990 | } |
991 | } |
992 | |
993 | # replace (*(Handle(A)*)&b) by Handle(A)::DownCast(b) |
994 | set index 0 |
995 | set pattern_ptrcast3 {([^A-Za-z0-9_]\s*)\(\s*[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)} |
996 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast3 $hxx location start class var] } { |
997 | set index [lindex $location 1] |
998 | |
999 | set start [eval string range \$hxx $start] |
1000 | set class [eval string range \$hxx $class] |
1001 | set var [eval string range \$hxx $var] |
1002 | |
1003 | if { ! $theCheckMode } { |
1004 | set change_flag 1 |
1005 | ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index |
1006 | } else { |
1007 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
1008 | } |
1009 | } |
1010 | |
1011 | # replace *(Handle(A)*)&b, by Handle(A)::DownCast(b), |
1012 | # replace *(Handle(A)*)&b; by Handle(A)::DownCast(b); |
1013 | # replace *(Handle(A)*)&b) by Handle(A)::DownCast(b)) |
1014 | set index 0 |
1015 | set pattern_ptrcast4 {[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)(\s*[,;\)])} |
1016 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast4 $hxx location class var end] } { |
1017 | set index [lindex $location 1] |
1018 | |
1019 | set class [eval string range \$hxx $class] |
1020 | set var [eval string range \$hxx $var] |
1021 | set end [eval string range \$hxx $end] |
1022 | |
1023 | if { ! $theCheckMode } { |
1024 | set change_flag 1 |
1025 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index |
1026 | } else { |
1027 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
1028 | } |
1029 | } |
1030 | |
1031 | # just warn if some casts to & are still there |
1032 | set index 0 |
1033 | set pattern_refcast0 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)} |
1034 | while { [regexp -start $index -indices -lineanchor $pattern_refcast0 $hxx location class var] } { |
1035 | set index [lindex $location 1] |
1036 | |
f5f4ebd0 |
1037 | set var [eval string range \$hxx $var] |
1038 | if { "$var" != "const" && "$var" != "Standard_OVERRIDE" } { |
1039 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
1040 | } |
d1a67b9d |
1041 | } |
1042 | |
1043 | # replace const Handle(A)& a = Handle(B)::DownCast (b); by |
1044 | # Handle(A) a ( Handle(B)::DownCast (b) ); |
1045 | set index 0 |
1046 | set pattern_refvar {\mconst\s+Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*=\s*(Handle\s*\(\s*[A-Za-z0-9_]+\s*\)\s*::\s*DownCast\s*\([^;]+);} |
1047 | while { [regexp -start $index -indices -lineanchor $pattern_refvar $hxx location class var hexpr] } { |
1048 | set index [lindex $location 1] |
1049 | |
1050 | set class [eval string range \$hxx $class] |
1051 | set var [eval string range \$hxx $var] |
1052 | set hexpr [eval string range \$hxx $hexpr] |
1053 | |
1054 | if { ! $theCheckMode } { |
1055 | set change_flag 1 |
1056 | ReplaceSubString hxx $location "Handle($class) $var ($hexpr);" index |
1057 | } else { |
1058 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
1059 | } |
1060 | } |
1061 | |
1062 | # apply changes to the header file |
1063 | if { $change_flag } { |
1064 | SaveTextToFile $afile $hxx |
1065 | } |
1066 | } |
1067 | } |
1068 | |
1069 | # Remove unnecessary forward declaration of a class if found immediately before |
1070 | # its use in DEFINE_STANDARD_HANDLE |
1071 | proc RemoveFwdClassForDefineStandardHandle {pkpath theCheckMode} { |
1072 | |
1073 | # iterate by header files |
1074 | foreach afile [glob -nocomplain -type f -directory $pkpath *.?xx] { |
1075 | |
1076 | # load a file |
1077 | if { [catch {set fd [open $afile rb]}] } { |
1078 | logerr "Error: cannot open $afile" |
1079 | continue |
1080 | } |
1081 | set hxx [read $fd] |
1082 | close $fd |
1083 | |
1084 | set change_flag 0 |
1085 | |
1086 | # replace |
1087 | set index 0 |
1088 | set pattern_fwddef {class\s+([A-Za-z0-9_]+)\s*;\s*DEFINE_STANDARD_HANDLE\s*\(\s*([A-Za-z0-9_]+)\s*,\s*([A-Za-z0-9_]+)\s*\)[ \t]*} |
1089 | while { [regexp -start $index -indices -lineanchor $pattern_fwddef $aProcessedFileContent location fwdclass class1 class2] } { |
1090 | set index [lindex $location 1] |
1091 | |
1092 | set fwdclass [eval string range \$aProcessedFileContent $fwdclass] |
1093 | set class1 [eval string range \$aProcessedFileContent $class1] |
1094 | set class2 [eval string range \$aProcessedFileContent $class2] |
1095 | |
1096 | if { $fwdclass != $class1 } { |
1097 | continue |
1098 | } |
1099 | |
1100 | if { ! $theCheckMode } { |
1101 | set change_flag 1 |
1102 | ReplaceSubString aProcessedFileContent $location "DEFINE_STANDARD_HANDLE($class1, $class2)" index |
1103 | incr index -1 |
1104 | } else { |
1105 | logwarn "Warning: $aProcessedFile contains unnecessary forward declarations of class $fwdclass" |
1106 | break |
1107 | } |
1108 | } |
1109 | |
1110 | # apply changes to the header file |
1111 | if { $change_flag } { |
1112 | SaveTextToFile $afile $hxx |
1113 | } |
1114 | } |
1115 | } |
1116 | |
1117 | # auxiliary: modifies variable text_var replacing part defined by two indices |
1118 | # given in location by string str, and updates index_var variable to point to |
1119 | # the end of the replaced string. Variable flag_var is set to 1. |
1120 | proc ReplaceSubString {theSource theLocation theSubstitute theEndIndex} { |
1121 | |
1122 | upvar $theSource aSource |
1123 | upvar $theEndIndex anEndIndex |
1124 | |
1125 | set aStartIndex [lindex $theLocation 0] |
1126 | set anEndIndex [lindex $theLocation 1] |
1127 | set aSource [string replace "$aSource" $aStartIndex $anEndIndex "$theSubstitute"] |
1128 | set anEndIndex [expr $aStartIndex + [string length $theSubstitute]] |
1129 | } |
1130 | |
1131 | # Save theFileContent some text to theFilePath file |
1132 | proc SaveTextToFile {theFilePath theFileContent} { |
1133 | if { [catch {set aFile [open ${theFilePath} w];} aReason] } { |
1134 | logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason" |
1135 | return |
1136 | } |
1137 | |
1138 | fconfigure $aFile -translation binary |
1139 | puts -nonewline $aFile "$theFileContent" |
1140 | close $aFile |
1141 | |
1142 | loginfo "File $theFilePath modified" |
1143 | } |
1144 | |
1145 | # read content from theFilePath to list, theFileContent is a raw content of the file |
1146 | proc ReadFileToList {theFilePath theFileContent theFileEOL} { |
1147 | upvar $theFileContent aFileContent |
1148 | upvar $theFileEOL aFileEOL |
1149 | |
1150 | if {"$theFilePath" == "" || ![file exists $theFilePath]} { |
1151 | return |
1152 | } |
1153 | |
1154 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1155 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1156 | return |
1157 | } |
1158 | |
1159 | fconfigure $aFile -translation binary |
1160 | set aFileContent [read $aFile] |
1161 | close $aFile |
1162 | |
155408bf |
1163 | # detect DOS end-of-lines |
1164 | if { [regexp "\r\n" $aFileContent] } { |
d1a67b9d |
1165 | set aFileEOL "\r\n" |
155408bf |
1166 | set aList [split [regsub -all "\r\n" $aFileContent "\n"] "\r\n"] |
1167 | } else { |
1168 | # standard UNIX end-of-lines |
d1a67b9d |
1169 | set aFileEOL "\n" |
155408bf |
1170 | set aList [split $aFileContent "\n"] |
d1a67b9d |
1171 | } |
1172 | |
d1a67b9d |
1173 | return $aList |
1174 | } |
1175 | |
1176 | # read content from theFilePath to raw text (with unix eol) |
1177 | proc ReadFileToRawText {theFilePath} { |
1178 | if {"$theFilePath" == "" || ![file exists $theFilePath]} { |
1179 | return |
1180 | } |
1181 | |
1182 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1183 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1184 | return |
1185 | } |
1186 | |
1187 | fconfigure $aFile -translation binary |
1188 | set aFileContent [read $aFile] |
1189 | close $aFile |
1190 | |
1191 | set aFileEOL "\r" |
1192 | if [regexp "\r\n" $aFileContent] { |
1193 | set aFileEOL "\r\n" |
1194 | } elseif [regexp "\n" $aFileContent] { |
1195 | set aFileEOL "\n" |
1196 | } |
1197 | |
1198 | # convert to unix eol |
1199 | if {"$aFileEOL" != "\n"} { |
1200 | regsub -all {$aFileEOL} $aFileContent "\n" aFileContent |
1201 | } |
1202 | |
1203 | return $aFileContent |
1204 | } |
1205 | |
1206 | # auxiliary: saves content of "theData" list to "theFilePath" |
1207 | proc SaveListToFile {theFilePath theData {theEOL "auto"}} { |
1208 | set anUsedEol $theEOL |
1209 | |
1210 | if {"$anUsedEol" == ""} { |
1211 | set anUsedEol "auto" |
1212 | } |
1213 | |
1214 | # if the file exists and "eol choice" is "auto", detect the file eol |
1215 | if {$anUsedEol == "auto" && [file exists $theFilePath]} { |
1216 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1217 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1218 | } else { |
1219 | fconfigure $aFile -translation binary |
1220 | set aFileContent [read $aFile] |
1221 | close $aFile |
1222 | |
1223 | set anUsedEol "\r" |
1224 | if [regexp "\r\n" $aFileContent] { |
1225 | set anUsedEol "\r\n" |
1226 | } elseif [regexp "\n" $aFileContent] { |
1227 | set anUsedEol "\n" |
1228 | } |
1229 | } |
1230 | } |
1231 | |
1232 | # write |
1233 | if { [catch {set aFile [open ${theFilePath} w];} aReason] } { |
1234 | logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason" |
1235 | return |
1236 | } |
1237 | |
1238 | fconfigure $aFile -translation binary |
1239 | puts -nonewline $aFile [join $theData $anUsedEol] |
1240 | close $aFile |
f5f4ebd0 |
1241 | |
1242 | loginfo "File $theFilePath modified" |
d1a67b9d |
1243 | } |
1244 | |
1245 | # collect all subdirs of theBaseDir |
1246 | proc CollectDirStructure {theBaseDir} { |
1247 | set aDirs [glob -nocomplain -directory $theBaseDir -type d *] |
1248 | |
1249 | set aSubDirs {} |
1250 | foreach aDir $aDirs { |
1251 | foreach aSubDir [CollectDirStructure $aDir] { |
1252 | lappend aSubDirs $aSubDir |
1253 | } |
1254 | } |
1255 | |
1256 | foreach aSubDir $aSubDirs { |
1257 | lappend aDirs $aSubDir |
1258 | } |
1259 | |
1260 | return $aDirs |
1261 | } |
1262 | |
1263 | # check existence of theFileName file in several folders (theIncPaths) |
1264 | proc SearchForFile {theIncPaths theFileName} { |
1265 | foreach aPath $theIncPaths { |
1266 | if {[file exists "${aPath}/${theFileName}"]} { |
1267 | return true |
1268 | } |
1269 | } |
1270 | |
1271 | return false |
1272 | } |
1273 | |
1274 | # auxiliary: parse the string to comment and not comment parts |
1275 | # variable "_cmnt" should be created before using the operation, it will save comment part of line |
1276 | # variable "_isMulti" should be created before the loop, equal to "false" if first line in the loop is not multi-comment line |
1277 | proc _check_line { line } { |
1278 | upvar _isMulti _isMulti |
1279 | upvar _cmnt _cmnt |
1280 | |
1281 | set string_length [string length $line] |
1282 | set c_b $string_length |
1283 | set mc_b $string_length |
1284 | set mc_e $string_length |
1285 | regexp -indices {//} $line c_b |
1286 | regexp -indices {/\*} $line mc_b |
1287 | regexp -indices {\*/} $line mc_e |
1288 | if {!${_isMulti}} { |
1289 | if {[lindex $c_b 0] < [lindex $mc_b 0] && [lindex $c_b 0] < [lindex $mc_e 0]} { |
1290 | set notComment_c [string range $line 0 [expr [lindex $c_b 0]-1]] |
1291 | set Comment_c [string range $line [lindex $c_b 0] end] |
1292 | set _cmnt $_cmnt$Comment_c |
1293 | return $notComment_c |
1294 | } elseif {[lindex $mc_b 0] < [lindex $c_b 0] && [lindex $mc_b 0] < [lindex $mc_e 0]} { |
1295 | set _isMulti true |
1296 | set _cmnt "${_cmnt}/*" |
1297 | set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]] |
1298 | set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end] |
1299 | return [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"] |
1300 | } elseif {[lindex $mc_e 0] < [lindex $c_b 0] && [lindex $mc_e 0] < [lindex $mc_b 0]} { |
1301 | set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end] |
1302 | set Comment_mc [string range $line 0 [expr [lindex $mc_e 0]-1]] |
1303 | set _cmnt "${_cmnt}${Comment_mc}*/" |
1304 | set chk [_check_line ${notComment_mc}] |
1305 | set _isMulti true |
1306 | return $chk |
1307 | } |
1308 | } else { |
1309 | if {[lindex $mc_e 0] < [lindex $mc_b 0]} { |
1310 | set _isMulti false |
1311 | set Comment_mc [string range $line 0 [lindex $mc_e 1]] |
1312 | set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end] |
1313 | set _cmnt $_cmnt$Comment_mc |
1314 | return [_check_line $notComment_mc] |
1315 | } elseif {[lindex $mc_b 0] < [lindex $mc_e 0] } { |
1316 | set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]] |
1317 | set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end] |
1318 | set _cmnt "${_cmnt}/*" |
1319 | set chk [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"] |
1320 | set _isMulti false |
1321 | return $chk |
1322 | } else { |
1323 | set _cmnt $_cmnt$line |
1324 | return "" |
1325 | } |
1326 | } |
1327 | return $line |
1328 | } |
1329 | |
1330 | # Create Tk-based logger which allows convenient consulting the upgrade process. |
1331 | proc _create_logger {} { |
1332 | if { [catch {winfo exists .h}] } { |
1333 | logerr "Error: Tk commands are not available, cannot create UI!" |
1334 | return |
1335 | } |
1336 | |
1337 | if { ![winfo exists .h ] } { |
1338 | toplevel .h |
1339 | wm title .h "Conversion log" |
1340 | wm geometry .h +320+200 |
1341 | wm resizable .h 0 0 |
1342 | |
1343 | text .h.t -yscrollcommand {.h.sbar set} |
1344 | scrollbar .h.sbar -orient vertical -command {.h.t yview} |
1345 | |
1346 | pack .h.sbar -side right -fill y |
1347 | pack .h.t |
1348 | } |
1349 | } |
1350 | |
1351 | set LogFilePath "" |
1352 | |
1353 | # Puts the passed string into Tk-based logger highlighting it with the |
1354 | # given color for better view. If no logger exists (-wlog option was not |
1355 | # activated), the standard output is used. |
1356 | proc _logcommon {theLogMessage {theMessageColor ""}} { |
1357 | global LogFilePath |
1358 | |
1359 | if {"$LogFilePath" != ""} { |
1360 | if { ! [catch {set aLogFile [open ${LogFilePath} a];} aReason] } { |
1361 | set t [clock milliseconds] |
1362 | set aTimeAndMessage [format "\[%s\] %s" \ |
1363 | [clock format [expr {$t / 1000}] -format %T] \ |
1364 | $theLogMessage \ |
1365 | ] |
1366 | |
1367 | |
1368 | puts $aLogFile $aTimeAndMessage |
1369 | close $aLogFile |
1370 | } else { |
1371 | logerr "Error: cannot open $LogFilePath log file due to $aReason" |
1372 | } |
1373 | } |
1374 | |
1375 | if { ! [catch {winfo exists .h} res] && $res } { |
1376 | .h.t insert end "$theLogMessage\n" |
1377 | |
1378 | if {$theLogMessage != ""} { |
1379 | # We use the current number of lines to generate unique tag in the text |
1380 | set aLineNb [lindex [split [.h.t index "end - 1 line"] "."] 0] |
1381 | |
1382 | .h.t tag add my_tag_$aLineNb end-2l end-1l |
1383 | .h.t tag configure my_tag_$aLineNb -background $theMessageColor |
1384 | } |
1385 | |
1386 | update |
1387 | } else { |
1388 | puts $theLogMessage |
1389 | } |
1390 | } |
1391 | |
1392 | # Puts information message to logger. |
1393 | proc loginfo {a} { |
1394 | _logcommon $a |
1395 | } |
1396 | |
1397 | # Puts warning message to logger. |
1398 | proc logwarn {a} { |
1399 | _logcommon $a "pink" |
1400 | } |
1401 | |
1402 | # Puts error message to logger. |
1403 | proc logerr {a} { |
1404 | _logcommon $a "red" |
1405 | } |