From 054fcde1d80b539852d566bbecf00dba98a48883 Mon Sep 17 00:00:00 2001 From: abv Date: Sat, 28 Nov 2015 11:59:07 +0300 Subject: [PATCH] Upgrade script --- adm/upgrade.tcl | 102 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 92 insertions(+), 10 deletions(-) diff --git a/adm/upgrade.tcl b/adm/upgrade.tcl index 204fca691b..dd314b011c 100644 --- a/adm/upgrade.tcl +++ b/adm/upgrade.tcl @@ -477,6 +477,71 @@ proc ConvertTColFwd {thePackagePath theHeaderExtensions} { } } +# try to find source file corresponding to the specified header and either +# inject macro IMPLEMENT_STANDARD_RTTIEXT in it, or check it already present, +# and depending on this, return suffix to be used for corresponding macro +# DEFINE_STANDARD_RTTI... (either inline or out-of-line variant) +proc DefineExplicitRtti {hxxfile class base theSourceExtensions} { + # if current file is not a header (by extension), exit with "inline" variant + # (there is no need to bother with out-of-line instantiations for local class) + set ext [file extension $hxxfile] + if { [lsearch -exact [split $theSourceExtensions ,] $ext] >=0 } { + return "_INLINE" + } + + # try to find source file with the same name but source-type extension + # in the same folder + set filename [file rootname $hxxfile] + foreach ext [split $theSourceExtensions ,] { +# puts "Checking ${filename}.$ext" + if { ! [file readable ${filename}.$ext] } { continue } + + # check the file content + set aFileContent [ReadFileToList ${filename}.$ext aFileRawContent aEOL] + + # try to find existing macro IMPLEMENT_STANDARD_RTTIEXT and check that + # it is consistent + foreach line $aFileContent { + if { [regexp {^\s*IMPLEMENT_STANDARD_RTTIEXT\s*\(\s*$class\s*,\s*([A-Za-z]+)\s*\)} $line res impl_base] } { + # implementation is in place, just report warning if second argument + # is different + if { $base != $impl_base } { + logwarn "Warning in ${filename}.$ext: second argument of macro" + logwarn " IMPLEMENT_STANDARD_RTTIEXT($class,$impl_base)" + logwarn " is not the same as detected base class, $base" + } + return "EXT" + } + } + + # inject a new macro before the first non-empty, non-comment, and + # non-preprocessor line + set aNewFileContent {} + set injected 0 + foreach line $aFileContent { + if { ! $injected && ! [regexp {^\s*//} $line] && + ! [regexp {^\s*$} $line] && ! [regexp {^\s*\#\s*include} $line] } { + set injected 1 + lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)" + if { ! [regexp "^IMPLEMENT_" $line] } { + lappend aNewFileContent "" + } + } + lappend aNewFileContent $line + } + if { ! $injected } { + lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)" + } + SaveListToFile ${filename}.$ext $aNewFileContent $aEOL + + return "EXT" + } + + logwarn "Warning in ${hxxfile}: cannot find corresponding source file," + logwarn " will use inline version of DEFINE_STANDARD_RTTI" + return "_INLINE" +} + # Parse source files and: # # - add second argument to macro DEFINE_STANDARD_RTTI specifying first base @@ -521,7 +586,7 @@ proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ # find all instances of DEFINE_STANDARD_RTTI with single or two arguments set index 0 - set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI\s*)\(\s*([A-Za-z_0-9,\s]+)\s*\)} + set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI)\s*\(\s*([A-Za-z_0-9,\s]+)\s*\)} while { [regexp -start $index -indices -lineanchor $pattern_rtti \ $aProcessedFileContent location start clist] } { set index [lindex $location 1] @@ -538,7 +603,12 @@ proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ logwarn "macro DEFINE_STANDARD_RTTI is changed assuming it inherits $inherits($class), please check!" } set change_flag 1 - ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index + # try to inject macro IMPLEMENT_STANDARD_RTTIEXT in the + # corresponding source file (or check it already present), + # and depending on this, use either inline or out-of-line variant + set rtti_suffix [DefineExplicitRtti $aProcessedFile $class $inherits($class) $theSourceExtensions] + ReplaceSubString aProcessedFileContent $location \ + "${start}${rtti_suffix}($class,$inherits($class))" index } } else { logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix" @@ -550,11 +620,16 @@ proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ logwarn "Warning in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file" } elseif { $base != $inherits($class) } { logwarn "Warning in $aProcessedFile: Second argument in macro DEFINE_STANDARD_RTTI for class $class is $base while $class seems to inherit from $inherits($class)" - if { ! $theCheckMode && ! [info exists inherits($class,multiple)] } { - set change_flag 1 - ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index + if { ! [info exists inherits($class,multiple)] } { + set base $inherits($class) } } + if { ! $theCheckMode } { + set change_flag 1 + set rtti_suffix [DefineExplicitRtti $aProcessedFile $class $base $theSourceExtensions] + ReplaceSubString aProcessedFileContent $location \ + "${start}${rtti_suffix}($class,$base)" index + } } } @@ -578,8 +653,12 @@ proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ set index 0 set first_newline \n\n set pattern_implement {\\?\n\s*IMPLEMENT_(DOWNCAST|STANDARD_[A-Z_]+|HARRAY1|HARRAY2|HUBTREE|HEBTREE|HSEQUENCE)\s*\([A-Za-z0-9_ ,]*\)\s*;?} - while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location] } { + while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location macro] } { set index [lindex $location 1] + # macro IMPLEMENT_STANDARD_RTTIEXT is retained + if { [eval string range \$aProcessedFileContent $macro] == "STANDARD_RTTIEXT" } { + continue + } if { ! $theCheckMode } { set change_flag 1 ReplaceSubString aProcessedFileContent $location $first_newline index @@ -1081,10 +1160,11 @@ proc ReadFileToList {theFilePath theFileContent theFileEOL} { regsub -all {$aFileEOL} $aFileContent "\n" aFileContent } - set aList {} - foreach aLine [split $aFileContent "\n"] { - lappend aList [string trimright $aLine] - } + set aList [split $aFileContent "\n"] +# set aList {} +# foreach aLine [split $aFileContent "\n"] { +# lappend aList [string trimright $aLine] +# } return $aList } @@ -1154,6 +1234,8 @@ proc SaveListToFile {theFilePath theData {theEOL "auto"}} { fconfigure $aFile -translation binary puts -nonewline $aFile [join $theData $anUsedEol] close $aFile + + loginfo "File $theFilePath modified" } # collect all subdirs of theBaseDir