1 # This script provides commands for upgrade of OCCT and software based on it
2 # to a newer version of OCCT (7.0)
5 # source code for upgrading
6 set ArgName(HelpInfo) "h"
8 set ArgName(SourceCode) "src"
9 set ArgName(IncPath) "inc"
11 set ArgName(IncExtension) "incext"
12 set ArgName(SrcExtension) "srcext"
14 set ArgName(RTTI) "rtti"
16 set ArgName(CStyleCastHandle) "handlecast"
17 set ArgName(All) "all"
19 set ArgName(Handle) "handle"
20 set ArgName(TCollection) "tcollection"
22 set ArgName(CompatibleMode) "compat"
24 set ArgName(Recurse) "recurse"
25 set ArgName(Rename) "rename"
27 set ArgName(CheckOnly) "check"
28 set ArgName(WLog) "wlog"
29 set ArgName(Log) "log"
31 proc HelpInformation {} {
33 global DataSectionName
35 loginfo "Tool for upgrade of application code from older versions of OCCT."
37 loginfo "Required parameter:"
38 loginfo " -$ArgName(SourceCode)=<path> - path to sources to upgrade"
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"
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"
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"
63 proc ParseArgs {theArgValues theArgs {theRemoveFromArgs "false"}} {
64 upvar $theArgValues anArgValues
67 global DataSectionName
70 set anArgValues(HelpInfo) [SeekArg $ArgName(HelpInfo) theArgs "false" $theRemoveFromArgs]
72 # sources that will be upgraded
73 set anArgValues(SourceCode) [SeekArg $ArgName(SourceCode) theArgs "" $theRemoveFromArgs]
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]
79 set anArgValues(IncPath) [SeekArg $ArgName(IncPath) theArgs "$anArgValues(SourceCode)" $theRemoveFromArgs]
81 set anArgValues(RTTI) [SeekArg $ArgName(RTTI) theArgs "false" $theRemoveFromArgs]
82 set anArgValues(CStyleCastHandle) [SeekArg $ArgName(CStyleCastHandle) theArgs "false" $theRemoveFromArgs]
84 set anArgValues(Handle) [SeekArg $ArgName(Handle) theArgs "false" $theRemoveFromArgs]
85 set anArgValues(TCollection) [SeekArg $ArgName(TCollection) theArgs "false" $theRemoveFromArgs]
87 set anArgValues(Rename) [SeekArg $ArgName(Rename) theArgs "false" $theRemoveFromArgs]
89 set aHasAgentArgs [expr {$anArgValues(RTTI) || $anArgValues(CStyleCastHandle) || \
90 $anArgValues(Handle) || $anArgValues(TCollection)} || \
93 set anArgValues(All) [SeekArg $ArgName(All) theArgs [expr {!$aHasAgentArgs}] $theRemoveFromArgs]
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]
100 set anArgValues(Log) [SeekArg $ArgName(Log) theArgs "" $theRemoveFromArgs]
105 proc SeekArg {theSoughtArgName theArgs {theDefaultArgValue ""} {theRemoveFromArgs false}} {
106 upvar ${theArgs} anArgs
108 set aBooleanValue [string is boolean -strict $theDefaultArgValue]
113 foreach anArg $anArgs {
116 if {[regexp -- "-${theSoughtArgName}\=\(.\*\)" $anArg dummy anArgValue]} {
117 set anArgValue [regsub -all {\\} $anArgValue {/}]
118 if {$theRemoveFromArgs} {
119 set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex]
122 if {"$anArgValue" != ""} {
123 lappend anArgValues $anArgValue
125 logwarn "'-${theSoughtArgName}' is skipped because it has empty value"
127 } elseif [string match "-${theSoughtArgName}" $anArg] {
128 if {$theRemoveFromArgs} {
129 set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex]
131 # skip non-boolean empty argument; do not break the foreach loop
132 if {$aBooleanValue} {
133 lappend anArgValues "true"
136 logwarn "'-${theSoughtArgName}' is skipped because it has empty value"
141 # return boolean value as string
142 if {$aBooleanValue} {
143 if {[llength $anArgValues] > 0} {
144 return [lindex $anArgValues 0]
146 return $theDefaultArgValue
150 if {[llength $anArgValues] == 0 && "$theDefaultArgValue" != ""} {
151 lappend anArgValues $theDefaultArgValue
157 # section names in the data file
158 set DataSectionName(TCollection) "tcollection"
159 set DataSectionName(Rename) "rename"
161 proc DataFileName {} {
162 return [file join [file dirname [info script]] upgrade.dat]
165 proc IsDataFileExist {} {
166 return [file exists [DataFileName]]
169 proc ReadFromDataFile {theSectionName} {
170 if {![file exists [DataFileName]]} {
174 set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL]
176 set aSectionValueList {}
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"} {
185 } elseif {$anIsSection == true} {
186 set anIsSection false
191 if {$anIsSection == true} {
192 set aTrimmedLine [string trimright $aLine]
193 if {"$aTrimmedLine" != ""} {
194 lappend aSectionValueList $aTrimmedLine
199 return $aSectionValueList
202 proc SaveToDataFile {theSectionName theSectionContent} {
203 if {![file exists [DataFileName]]} {
207 set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL]
212 set anIsSection false
213 set anIsSectionBefore true
214 set anIsSectionAfter false
216 set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+}
217 foreach aLine $aFileContent {
218 if {$anIsSectionBefore} {
219 lappend aLinesBefore $aLine
222 if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} {
223 if {"$aSectionName" == "$theSectionName"} {
224 set anIsSectionBefore false
226 } elseif {$anIsSection == true} {
227 set anIsSection false
228 set anIsSectionAfter true
232 if {$anIsSection == true} {
236 if {$anIsSectionAfter} {
237 lappend aLinesAfter $aLine
242 SaveListToFile [DataFileName] [list {*}$aLinesBefore {*}$theSectionContent {*}$aLinesAfter] $aDataEOL
245 # Main tool, accepts path to location of source tree to be upgraded.
246 proc upgrade {args} {
250 global DataSectionName
253 set anUnparsedArgs [ParseArgs anArgValues $theArgs "true"]
255 if {"$anUnparsedArgs" != ""} {
256 logerr "undefined arguments: $anUnparsedArgs"
257 loginfo "use -$ArgName(HelpInfo) to show all the arguments"
261 if {$anArgValues(HelpInfo) || [llength $anArgValues(SourceCode)] == 0} {
266 if {"$anArgValues(Log)" != ""} {
267 set LogFilePath $anArgValues(Log)
269 # clean file before writing
270 if {[file exists "$LogFilePath"]} {
271 set fd [open "$LogFilePath" r+]
277 if {$anArgValues(WLog)} {
281 # collect src directory structure (all subdirs)
283 foreach aSrcDir $anArgValues(SourceCode) {
284 lappend anIncPaths $aSrcDir
285 foreach aSubSrcDir [CollectDirStructure $aSrcDir] {
286 lappend anIncPaths $aSubSrcDir
290 foreach anIncDir $anArgValues(IncPath) {
291 lappend anIncPaths $anIncDir
292 foreach aSubIncDir [CollectDirStructure $anIncDir] {
293 lappend anIncPaths $aSubIncDir
297 set anIncPaths [lsort -unique -dictionary $anIncPaths]
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]
310 if {[llength [array names aNewNames]] == 0} {
313 logwarn "renaming skipped. there is no class names to rename"
314 logwarn "see the content of [DataFileName] file, $DataSectionName(Rename) section"
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)"]
324 set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)=$anArgValues($anArgName)"]
328 loginfo "$aProcNameWithArgs"
330 # merge all processed extensions
331 set anExtensions "$anArgValues(SrcExtension),$anArgValues(IncExtension)"
333 set aSourceCodePaths $anArgValues(SourceCode)
334 while {[llength $aSourceCodePaths]} {
335 set aSourceCodePaths [lassign $aSourceCodePaths aProcessedPath]
337 loginfo "Processing: $aProcessedPath"
339 if {$anArgValues(All) || $anArgValues(RTTI)} {
340 ConvertRtti $aProcessedPath \
342 $anArgValues(CheckOnly) \
343 $anArgValues(CompatibleMode) \
344 $anArgValues(IncExtension) \
345 $anArgValues(SrcExtension)
348 if {$anArgValues(All) || $anArgValues(Handle)} {
349 ConvertHandle $aProcessedPath $anIncPaths $anArgValues(CheckOnly) $anExtensions
352 if {$anArgValues(All) || $anArgValues(TCollection)} {
353 ConvertTColFwd $aProcessedPath $anArgValues(IncExtension)
356 if {$anArgValues(All) || $anArgValues(CStyleCastHandle)} {
357 ConvertCStyleHandleCast $aProcessedPath $anExtensions $anArgValues(CheckOnly)
360 if {$anArgValues(All) || $anArgValues(Rename)} {
362 Rename $aProcessedPath $anExtensions aNewNames $anArgValues(CheckOnly)
367 if {$anArgValues(Recurse)} {
368 lappend aSourceCodePaths {*}[glob -nocomplain -directory $aProcessedPath -type d *]
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
378 set aNames [array names aNewNames]
380 foreach aFile [glob -nocomplain -type f -directory $thePath *.{$theExtensions}] {
381 # loginfo "$aFile processing"
382 set aFileContent [ReadFileToRawText $aFile]
384 set aHasChanges false
385 foreach aName $aNames {
387 set aClassNameTmpl "\\m$aName\\M"
388 while { [regexp -start $anIndexInRow -indices -lineanchor $aClassNameTmpl $aFileContent aFoundClassNameLoc] } {
389 set anIndexInRow [lindex $aFoundClassNameLoc 1]
392 logwarn "Warning: $aFile contains $aName"
396 ReplaceSubString aFileContent $aFoundClassNameLoc "$aNewNames($aName)" anIndexInRow
403 SaveTextToFile $aFile $aFileContent
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
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
419 if {! [file exists $thePackagePath]} {
420 logerr "Error: $thePackagePath does not exist"
424 # read the list of already converted TCollection classes
425 if [IsDataFileExist] {
426 set aConvertedTColClasses [ReadFromDataFile $DataSectionName(TCollection)]
428 logerr "[DataFileName] file of upgrade process does not exist"
432 # pattern that will be used
433 set aForwardDeclPattern {^ *class *([A-Za-z0-9_/\.]+) *;}
435 set aTargetPaths ${thePackagePath}
436 while {[llength $aTargetPaths]} {
437 set aTargetPaths [lassign $aTargetPaths aProcessedPath]
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}]
446 foreach aHeader $aProcessedHeaders {
447 set aHeaderLineIndex -1
448 set aHeaderContentUpdated false
450 # read the content of the header file
451 set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL]
453 # remove _isMulti variable that used in _check_line
456 foreach aHeaderContentLine $aHeaderContent {
457 incr aHeaderLineIndex
459 # remove _cmnt variable that used in _check_line
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]
472 if {$aHeaderContentUpdated} {
473 loginfo "$aHeader updated"
474 SaveListToFile $aHeader $aHeaderContent $aHeaderEOL
480 # Parse source files and:
482 # - add second argument to macro DEFINE_STANDARD_RTTI specifying first base
483 # class found in the class declaration;
484 # - replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx;
485 # - add #includes for all classes used as argument to macro
486 # STANDARD_TYPE(), except of already included ones
488 # If theCompatibleMode is false, in addition:
489 # - removes macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
490 proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \
491 theHeaderExtensions theSourceExtensions} {
493 # iterate by header and source files
494 foreach aProcessedFile [glob -nocomplain -type f -directory $theProcessedPath *.{$theHeaderExtensions,$theSourceExtensions}] {
495 set aProcessedFileName [file tail $aProcessedFile]
497 set aProcessedFileContent [ReadFileToRawText $aProcessedFile]
499 # find all declarations of classes with public base in this header file;
500 # the result is stored in array inherits(class)
503 set pattern_class {^\s*class\s+([A-Za-z_0-9:]+)\s*:\s*public\s+([A-Za-z_0-9:]+)\s*([,]?)}
504 while {[regexp -start $index -indices -lineanchor $pattern_class $aProcessedFileContent location class base comma]} {
505 set index [lindex $location 1]
507 set class [eval string range \$aProcessedFileContent $class]
508 set base [eval string range \$aProcessedFileContent $base]
510 if { [info exists inherits($class)] } {
511 set inherits($class,multiple) "found multiple declarations of class $class"
513 if { [lindex $comma 0] <= [lindex $comma 1] } {
514 set inherits($class,multiple) "class $class uses multiple inheritance"
516 set inherits($class) $base
522 # find all instances of DEFINE_STANDARD_RTTI with single or two arguments
524 set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI\s*)\(\s*([A-Za-z_0-9,\s]+)\s*\)}
525 while { [regexp -start $index -indices -lineanchor $pattern_rtti \
526 $aProcessedFileContent location start clist] } {
527 set index [lindex $location 1]
529 set start [eval string range \$aProcessedFileContent $start]
530 set clist [split [eval string range \$aProcessedFileContent $clist] ,]
532 if { [llength $clist] == 1 } {
533 set class [string trim [lindex $clist 0]]
534 if { [info exists inherits($class)] } {
535 if { ! $theCheckMode } {
536 if { [info exists inherits($class,multiple)] } {
537 logwarn "Warning in $aProcessedFileName: $inherits($class,multiple);"
538 logwarn "macro DEFINE_STANDARD_RTTI is changed assuming it inherits $inherits($class), please check!"
541 ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index
544 logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix"
546 } elseif { [llength $clist] == 2 } {
547 set class [string trim [lindex $clist 0]]
548 set base [string trim [lindex $clist 1]]
549 if { ! [info exists inherits($class)] } {
550 logwarn "Warning in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file"
551 } elseif { $base != $inherits($class) } {
552 logwarn "Warning in $aProcessedFile: Second argument in macro DEFINE_STANDARD_RTTI for class $class is $base while $class seems to inherit from $inherits($class)"
553 if { ! $theCheckMode && ! [info exists inherits($class,multiple)] } {
555 ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index
561 # replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx
563 # set pattern_definehandle {\#\s*include\s*<\s*Standard_DefineHandle.hxx\s*>}
564 # while { [regexp -start $index -indices -lineanchor $pattern_definehandle $aProcessedFileContent location] } {
565 # set index [lindex $location 1]
566 # if { ! $theCheckMode } {
568 # ReplaceSubString aProcessedFileContent $location "\#include <Standard_Type.hxx>" index
571 # logwarn "Warning: $aProcessedFile contains obsolete forward declarations of Handle classes"
576 # remove macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
577 if { ! $theCompatibleMode } {
579 set first_newline \n\n
580 set pattern_implement {\\?\n\s*IMPLEMENT_(DOWNCAST|STANDARD_[A-Z_]+|HARRAY1|HARRAY2|HUBTREE|HEBTREE|HSEQUENCE)\s*\([A-Za-z0-9_ ,]*\)\s*;?}
581 while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location] } {
582 set index [lindex $location 1]
583 if { ! $theCheckMode } {
585 ReplaceSubString aProcessedFileContent $location $first_newline index
586 # set first_newline ""
589 logwarn "Warning: $aProcessedFile contains deprecated macros IMPLEMENT_*"
595 # find all uses of macro STANDARD_TYPE and method DownCast and ensure that
596 # argument class is explicitly included
597 set pattern_incbeg {\s*#\s*include\s*[\"<]\s*}
598 set pattern_incend {[.][a-zA-Z]+\s*[\">]}
601 set pattern_type1 {STANDARD_TYPE\s*\(\s*([A-Za-z0-9_]+)\s*\)}
602 while { [regexp -start $index -indices $pattern_type1 $aProcessedFileContent location name] } {
603 set index [lindex $location 1]
604 set name [eval string range \$aProcessedFileContent $name]
605 if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] &&
606 [lsearch -exact $addtype $name] < 0 &&
607 [SearchForFile $theIncPaths $name.hxx]} {
608 lappend addtype $name
611 set pattern_type2 {Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*::\s*DownCast}
612 while { [regexp -start $index -indices $pattern_type2 $aProcessedFileContent location name] } {
613 set index [lindex $location 1]
614 set name [eval string range \$aProcessedFileContent $name]
615 if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] &&
616 [lsearch -exact $addtype $name] < 0 &&
617 [SearchForFile $theIncPaths $name.hxx]} {
618 lappend addtype $name
621 if { [llength $addtype] > 0 } {
622 if { ! $theCheckMode } {
624 foreach type $addtype {
625 append addinc "\n#include <$type.hxx>"
627 if { [regexp -indices ".*\n${pattern_incbeg}\[A-Za-z0-9_/\]+${pattern_incend}" $aProcessedFileContent location] } {
629 ReplaceSubString aProcessedFileContent $location "[eval string range \$aProcessedFileContent $location]$addinc" index
631 logerr "Error: $aProcessedFile: Cannot find #include statement to add more includes..."
634 logwarn "Warning: $aProcessedFile: The following class names are used as arguments of STANDARD_TYPE"
635 logwarn " macro, but not included directly: $addtype"
640 # apply changes to the header file
641 if { $change_flag } {
642 SaveTextToFile $aProcessedFile $aProcessedFileContent
647 # replace all forward declarations of "class Handle(...)" with fwd of "class ..."
648 proc ConvertHandle {theTargetPath theIncPaths theCheckMode theExtensions} {
650 # iterate by header files
651 foreach aHeader [glob -nocomplain -type f -directory $theTargetPath *.{$theExtensions}] {
653 # skip gxx files, as names Handle_xxx used there are in most cases
654 # placeholders of the argument types substituted by #define
655 if {[file extension $aHeader] == ".gxx"} {
659 # read the content of the header
660 if { [catch {set fd [open $aHeader rb]}] } {
661 logerr "Error: cannot open $aHeader"
666 set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL]
668 set anUpdateHeader false
670 # if file contains "slots:" or "signals:", assume it defines some QObject
672 # In this case, type names "Handle_T" will not be replaced by Handle(T) to
673 # prevent failure of compilation of MOC code if such types are used in
674 # slots or signals (MOC does not expand macros).
675 # Forward declaration of a Handle will be then replaced by #include of
676 # corresponding class header (if such header is found), assuming that name
677 # typedefed Handle_T is defined in corresponding header (as typedef).
678 set isQObject [expr [regexp "Q_OBJECT" $aHeaderContent] && [regexp "(slots|signals)\s*:" $aHeaderContent]]
680 # replace all IDs with prefix Handle_ by use of Handle() macro
681 if { ! $isQObject } {
682 set anUpdatedHeaderContent {}
683 set pattern_handle {\mHandle_([A-Za-z0-9_]+)}
684 foreach line $aHeaderContent {
685 # do not touch #include and #if... statements
686 if { [regexp {\s*\#\s*include} $line] || [regexp {\s*\#\s*if} $line] } {
687 lappend anUpdatedHeaderContent $line
691 # in other preprocessor statements, skip first expression to avoid
692 # replacements in #define Handle_... and similar cases
694 if { [regexp -indices {\s*#\s*[A-Za-z]+\s+[^\s]+} $line location] } {
695 set index [expr 1 + [lindex $location 1]]
698 # replace Handle_T by Handle(T)
699 while { [regexp -start $index -indices $pattern_handle $line location class] } {
700 set index [lindex $location 1]
702 set class [eval string range \$line $class]
703 # puts "Found: [eval string range \$line $location]"
705 if { ! $theCheckMode } {
706 set anUpdateHeader true
707 ReplaceSubString line $location "Handle($class)" index
709 logwarn "Warning: $aHeader refers to IDs starting with \"Handle_\" which are likely"
710 logwarn " instances of OCCT Handle classes (e.g. \"$class\"); these are to be "
711 logwarn " replaced by template opencascade::handle<> or legacy macro Handle()"
712 set index -1 ;# to break outer cycle
716 lappend anUpdatedHeaderContent $line
719 set anUpdatedHeaderContent $aHeaderContent
723 set aHeaderContent $anUpdatedHeaderContent
726 # replace NS::Handle(A) by Handle(NS::A)
727 set anUpdatedHeaderContent {}
728 set pattern_nshandle {([A-Za-z0-9_]+)\s*::\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)}
729 foreach line $aHeaderContent {
732 while { [regexp -start $index -indices -lineanchor $pattern_nshandle $line location scope class]} {
733 set index [lindex $location 1]
735 set scope [eval string range \$line $scope]
736 set class [eval string range \$line $class]
738 if { ! $theCheckMode } {
739 set anUpdateHeader true
740 ReplaceSubString line $location "Handle(${scope}::${class})" index
742 logwarn "Warning in $aHeader: usage of Handle macro inside scope is incorrect: [eval string range \$line $location]"
743 set index -1 ;# to break outer cycle
747 lappend anUpdatedHeaderContent $line
750 set anUpdatedHeaderContent $aHeaderContent
754 set aHeaderContent $anUpdatedHeaderContent
756 # remove all forward declarations of Handle classes
757 set anUpdatedHeaderContent {}
758 set aFwdHandlePattern {^\s*class\s+Handle[_\(]([A-Za-z0-9_]+)[\)]?\s*\;\s*$}
759 foreach aHeaderContentLine $aHeaderContent {
760 if {[regexp $aFwdHandlePattern $aHeaderContentLine dummy aForwardDeclHandledClass]} {
762 loginfo "Info: $aHeader contains statement involving forward decl of Handle_$aForwardDeclHandledClass"
764 # replace by forward declaration of a class or its include unless
765 # it is already declared or included
766 if { ! [regexp "^\s*\#\s*include\s*\[\<\"\]\s*$aForwardDeclHandledClass\s*\[\>\"\]" $aHeaderContent] } {
768 lappend anUpdatedHeaderContent "#include <${aForwardDeclHandledClass}.hxx>"
769 if { ! [SearchForFile $theIncPaths ${aForwardDeclHandledClass}.hxx] } {
770 loginfo "Warning: include ${aForwardDeclHandledClass}.hxx added in $aHeader, assuming it exists and defines Handle_$aForwardDeclHandledClass"
772 } elseif { ! [regexp "^\s*class\s+$aForwardDeclHandledClass\s*;" $aHeaderContent] } {
773 lappend anUpdatedHeaderContent "class $aForwardDeclHandledClass;"
776 set anUpdateHeader true
780 lappend anUpdatedHeaderContent $aHeaderContentLine
782 set aHeaderContent $anUpdatedHeaderContent
784 # remove all typedefs using Handle() macro to generate typedefed name
785 set anUpdatedHeaderContent {}
786 set aTypedefHandlePattern {^\s*typedef\s+[_A-Za-z\<\>, \s]+\s+Handle\([A-Za-z0-9_]+\)\s*\;\s*$}
787 foreach aHeaderContentLine $aHeaderContent {
788 if {[regexp $aTypedefHandlePattern $aHeaderContentLine aFoundPattern]} {
790 loginfo "Info: $aHeader contains typedef using Handle macro to generate name: $aFoundPattern"
792 set anUpdateHeader true
796 lappend anUpdatedHeaderContent $aHeaderContentLine
798 set aHeaderContent $anUpdatedHeaderContent
800 # remove all #include statements for files starting with "Handle_"
801 set anUpdatedHeaderContent {}
802 set anIncHandlePattern {^\s*\#\s*include\s+[\<\"]\s*(Handle[\(_][A-Za-z0-9_.]+[\)]?)\s*[\>\"]\s*$}
803 foreach aHeaderContentLine $aHeaderContent {
804 if {[regexp $anIncHandlePattern $aHeaderContentLine aFoundPattern anHxxName] &&
805 ! [SearchForFile $theIncPaths $anHxxName]} {
807 loginfo "Info: $aHeader includes missing header: $anHxxName"
809 set anUpdateHeader true
813 lappend anUpdatedHeaderContent $aHeaderContentLine
817 if {$anUpdateHeader} {
818 SaveListToFile $aHeader $anUpdatedHeaderContent $aHeaderEOL
823 # Replaces C-style casts of Handle object to Handle to derived type
824 # by call to DownCast() method
825 proc ConvertCStyleHandleCast {pkpath theExtensions theCheckMode} {
827 # iterate by header files
828 foreach afile [glob -nocomplain -type f -directory $pkpath *.\{$theExtensions\}] {
829 set hxx [ReadFileToRawText $afile]
833 # replace ((Handle(A)&)b) by Handle(A)::DownCast(b)
835 set pattern_refcast1 {\(\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)\)}
836 while { [regexp -start $index -indices -lineanchor $pattern_refcast1 $hxx location class var]} {
837 set index [lindex $location 1]
839 set class [eval string range \$hxx $class]
840 set var [eval string range \$hxx $var]
842 if { ! $theCheckMode } {
844 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
846 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
850 # replace (Handle(A)&)b, by Handle(A)::DownCast(b),
851 # replace (Handle(A)&)b; by Handle(A)::DownCast(b);
852 # replace (Handle(A)&)b) by Handle(A)::DownCast(b))
854 set pattern_refcast2 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)(\s*[,;\)])}
855 while { [regexp -start $index -indices -lineanchor $pattern_refcast2 $hxx location class var end]} {
856 set index [lindex $location 1]
858 set class [eval string range \$hxx $class]
859 set var [eval string range \$hxx $var]
860 set end [eval string range \$hxx $end]
862 if { ! $theCheckMode } {
864 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
866 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
870 # replace (*((Handle(A)*)&b)) by Handle(A)::DownCast(b)
872 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*\)}
873 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast1 $hxx location start class var] } {
874 set index [lindex $location 1]
876 set start [eval string range \$hxx $start]
877 set class [eval string range \$hxx $class]
878 set var [eval string range \$hxx $var]
880 if { ! $theCheckMode } {
882 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
884 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
888 # replace *((Handle(A)*)&b) by Handle(A)::DownCast(b)
890 set pattern_ptrcast2 {[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)}
891 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast2 $hxx location class var] } {
892 set index [lindex $location 1]
894 set class [eval string range \$hxx $class]
895 set var [eval string range \$hxx $var]
897 if { ! $theCheckMode } {
899 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
901 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
905 # replace (*(Handle(A)*)&b) by Handle(A)::DownCast(b)
907 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*\)}
908 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast3 $hxx location start class var] } {
909 set index [lindex $location 1]
911 set start [eval string range \$hxx $start]
912 set class [eval string range \$hxx $class]
913 set var [eval string range \$hxx $var]
915 if { ! $theCheckMode } {
917 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
919 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
923 # replace *(Handle(A)*)&b, by Handle(A)::DownCast(b),
924 # replace *(Handle(A)*)&b; by Handle(A)::DownCast(b);
925 # replace *(Handle(A)*)&b) by Handle(A)::DownCast(b))
927 set pattern_ptrcast4 {[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)(\s*[,;\)])}
928 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast4 $hxx location class var end] } {
929 set index [lindex $location 1]
931 set class [eval string range \$hxx $class]
932 set var [eval string range \$hxx $var]
933 set end [eval string range \$hxx $end]
935 if { ! $theCheckMode } {
937 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
939 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
943 # just warn if some casts to & are still there
945 set pattern_refcast0 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)}
946 while { [regexp -start $index -indices -lineanchor $pattern_refcast0 $hxx location class var] } {
947 set index [lindex $location 1]
949 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
952 # replace const Handle(A)& a = Handle(B)::DownCast (b); by
953 # Handle(A) a ( Handle(B)::DownCast (b) );
955 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*\([^;]+);}
956 while { [regexp -start $index -indices -lineanchor $pattern_refvar $hxx location class var hexpr] } {
957 set index [lindex $location 1]
959 set class [eval string range \$hxx $class]
960 set var [eval string range \$hxx $var]
961 set hexpr [eval string range \$hxx $hexpr]
963 if { ! $theCheckMode } {
965 ReplaceSubString hxx $location "Handle($class) $var ($hexpr);" index
967 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
971 # apply changes to the header file
972 if { $change_flag } {
973 SaveTextToFile $afile $hxx
978 # Remove unnecessary forward declaration of a class if found immediately before
979 # its use in DEFINE_STANDARD_HANDLE
980 proc RemoveFwdClassForDefineStandardHandle {pkpath theCheckMode} {
982 # iterate by header files
983 foreach afile [glob -nocomplain -type f -directory $pkpath *.?xx] {
986 if { [catch {set fd [open $afile rb]}] } {
987 logerr "Error: cannot open $afile"
997 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]*}
998 while { [regexp -start $index -indices -lineanchor $pattern_fwddef $aProcessedFileContent location fwdclass class1 class2] } {
999 set index [lindex $location 1]
1001 set fwdclass [eval string range \$aProcessedFileContent $fwdclass]
1002 set class1 [eval string range \$aProcessedFileContent $class1]
1003 set class2 [eval string range \$aProcessedFileContent $class2]
1005 if { $fwdclass != $class1 } {
1009 if { ! $theCheckMode } {
1011 ReplaceSubString aProcessedFileContent $location "DEFINE_STANDARD_HANDLE($class1, $class2)" index
1014 logwarn "Warning: $aProcessedFile contains unnecessary forward declarations of class $fwdclass"
1019 # apply changes to the header file
1020 if { $change_flag } {
1021 SaveTextToFile $afile $hxx
1026 # auxiliary: modifies variable text_var replacing part defined by two indices
1027 # given in location by string str, and updates index_var variable to point to
1028 # the end of the replaced string. Variable flag_var is set to 1.
1029 proc ReplaceSubString {theSource theLocation theSubstitute theEndIndex} {
1031 upvar $theSource aSource
1032 upvar $theEndIndex anEndIndex
1034 set aStartIndex [lindex $theLocation 0]
1035 set anEndIndex [lindex $theLocation 1]
1036 set aSource [string replace "$aSource" $aStartIndex $anEndIndex "$theSubstitute"]
1037 set anEndIndex [expr $aStartIndex + [string length $theSubstitute]]
1040 # Save theFileContent some text to theFilePath file
1041 proc SaveTextToFile {theFilePath theFileContent} {
1042 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1043 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1047 fconfigure $aFile -translation binary
1048 puts -nonewline $aFile "$theFileContent"
1051 loginfo "File $theFilePath modified"
1054 # read content from theFilePath to list, theFileContent is a raw content of the file
1055 proc ReadFileToList {theFilePath theFileContent theFileEOL} {
1056 upvar $theFileContent aFileContent
1057 upvar $theFileEOL aFileEOL
1059 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1063 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1064 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1068 fconfigure $aFile -translation binary
1069 set aFileContent [read $aFile]
1073 if [regexp "\r\n" $aFileContent] {
1075 } elseif [regexp "\n" $aFileContent] {
1079 # convert to unix eol
1080 if {"$aFileEOL" != "\n"} {
1081 regsub -all {$aFileEOL} $aFileContent "\n" aFileContent
1085 foreach aLine [split $aFileContent "\n"] {
1086 lappend aList [string trimright $aLine]
1092 # read content from theFilePath to raw text (with unix eol)
1093 proc ReadFileToRawText {theFilePath} {
1094 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1098 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1099 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1103 fconfigure $aFile -translation binary
1104 set aFileContent [read $aFile]
1108 if [regexp "\r\n" $aFileContent] {
1110 } elseif [regexp "\n" $aFileContent] {
1114 # convert to unix eol
1115 if {"$aFileEOL" != "\n"} {
1116 regsub -all {$aFileEOL} $aFileContent "\n" aFileContent
1119 return $aFileContent
1122 # auxiliary: saves content of "theData" list to "theFilePath"
1123 proc SaveListToFile {theFilePath theData {theEOL "auto"}} {
1124 set anUsedEol $theEOL
1126 if {"$anUsedEol" == ""} {
1127 set anUsedEol "auto"
1130 # if the file exists and "eol choice" is "auto", detect the file eol
1131 if {$anUsedEol == "auto" && [file exists $theFilePath]} {
1132 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1133 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1135 fconfigure $aFile -translation binary
1136 set aFileContent [read $aFile]
1140 if [regexp "\r\n" $aFileContent] {
1141 set anUsedEol "\r\n"
1142 } elseif [regexp "\n" $aFileContent] {
1149 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1150 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1154 fconfigure $aFile -translation binary
1155 puts -nonewline $aFile [join $theData $anUsedEol]
1159 # collect all subdirs of theBaseDir
1160 proc CollectDirStructure {theBaseDir} {
1161 set aDirs [glob -nocomplain -directory $theBaseDir -type d *]
1164 foreach aDir $aDirs {
1165 foreach aSubDir [CollectDirStructure $aDir] {
1166 lappend aSubDirs $aSubDir
1170 foreach aSubDir $aSubDirs {
1171 lappend aDirs $aSubDir
1177 # check existence of theFileName file in several folders (theIncPaths)
1178 proc SearchForFile {theIncPaths theFileName} {
1179 foreach aPath $theIncPaths {
1180 if {[file exists "${aPath}/${theFileName}"]} {
1188 # auxiliary: parse the string to comment and not comment parts
1189 # variable "_cmnt" should be created before using the operation, it will save comment part of line
1190 # variable "_isMulti" should be created before the loop, equal to "false" if first line in the loop is not multi-comment line
1191 proc _check_line { line } {
1192 upvar _isMulti _isMulti
1195 set string_length [string length $line]
1196 set c_b $string_length
1197 set mc_b $string_length
1198 set mc_e $string_length
1199 regexp -indices {//} $line c_b
1200 regexp -indices {/\*} $line mc_b
1201 regexp -indices {\*/} $line mc_e
1203 if {[lindex $c_b 0] < [lindex $mc_b 0] && [lindex $c_b 0] < [lindex $mc_e 0]} {
1204 set notComment_c [string range $line 0 [expr [lindex $c_b 0]-1]]
1205 set Comment_c [string range $line [lindex $c_b 0] end]
1206 set _cmnt $_cmnt$Comment_c
1207 return $notComment_c
1208 } elseif {[lindex $mc_b 0] < [lindex $c_b 0] && [lindex $mc_b 0] < [lindex $mc_e 0]} {
1210 set _cmnt "${_cmnt}/*"
1211 set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]]
1212 set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end]
1213 return [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"]
1214 } elseif {[lindex $mc_e 0] < [lindex $c_b 0] && [lindex $mc_e 0] < [lindex $mc_b 0]} {
1215 set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end]
1216 set Comment_mc [string range $line 0 [expr [lindex $mc_e 0]-1]]
1217 set _cmnt "${_cmnt}${Comment_mc}*/"
1218 set chk [_check_line ${notComment_mc}]
1223 if {[lindex $mc_e 0] < [lindex $mc_b 0]} {
1225 set Comment_mc [string range $line 0 [lindex $mc_e 1]]
1226 set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end]
1227 set _cmnt $_cmnt$Comment_mc
1228 return [_check_line $notComment_mc]
1229 } elseif {[lindex $mc_b 0] < [lindex $mc_e 0] } {
1230 set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]]
1231 set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end]
1232 set _cmnt "${_cmnt}/*"
1233 set chk [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"]
1237 set _cmnt $_cmnt$line
1244 # Create Tk-based logger which allows convenient consulting the upgrade process.
1245 proc _create_logger {} {
1246 if { [catch {winfo exists .h}] } {
1247 logerr "Error: Tk commands are not available, cannot create UI!"
1251 if { ![winfo exists .h ] } {
1253 wm title .h "Conversion log"
1254 wm geometry .h +320+200
1257 text .h.t -yscrollcommand {.h.sbar set}
1258 scrollbar .h.sbar -orient vertical -command {.h.t yview}
1260 pack .h.sbar -side right -fill y
1267 # Puts the passed string into Tk-based logger highlighting it with the
1268 # given color for better view. If no logger exists (-wlog option was not
1269 # activated), the standard output is used.
1270 proc _logcommon {theLogMessage {theMessageColor ""}} {
1273 if {"$LogFilePath" != ""} {
1274 if { ! [catch {set aLogFile [open ${LogFilePath} a];} aReason] } {
1275 set t [clock milliseconds]
1276 set aTimeAndMessage [format "\[%s\] %s" \
1277 [clock format [expr {$t / 1000}] -format %T] \
1282 puts $aLogFile $aTimeAndMessage
1285 logerr "Error: cannot open $LogFilePath log file due to $aReason"
1289 if { ! [catch {winfo exists .h} res] && $res } {
1290 .h.t insert end "$theLogMessage\n"
1292 if {$theLogMessage != ""} {
1293 # We use the current number of lines to generate unique tag in the text
1294 set aLineNb [lindex [split [.h.t index "end - 1 line"] "."] 0]
1296 .h.t tag add my_tag_$aLineNb end-2l end-1l
1297 .h.t tag configure my_tag_$aLineNb -background $theMessageColor
1306 # Puts information message to logger.
1311 # Puts warning message to logger.
1313 _logcommon $a "pink"
1316 # Puts error message to logger.