package provides for the dynamic modification of a user’s environment via modulefiles.
| modspec.tcl (modules-5.1.1.tar.bz2) | : | modspec.tcl (modules-5.2.0.tar.bz2) |
|---|
| | |
| skipping to change at line 32 | | skipping to change at line 32 |
|---|
| # Adapt procedure code whether icase is enabled or disabled | | # Adapt procedure code whether icase is enabled or disabled |
| proc defineModStartNbProc {icase} { | | proc defineModStartNbProc {icase} { |
| set procname modStartNbProc | | set procname modStartNbProc |
| if {$icase} { | | if {$icase} { |
| append procname Icase | | append procname Icase |
| } | | } |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs modStartNb] eq {} || $::g_modStartNb_proc ne $procname} { | | if {[info procs modStartNb] eq {} || $::g_modStartNb_proc ne $procname} { |
| if {[info exists ::g_modStartNb_proc]} { | | if {[info exists ::g_modStartNb_proc]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution modStartNb enter reportTraceExecEnter | | initProcReportTrace remove modStartNb |
| rename ::modStartNb ::$::g_modStartNb_proc | | rename ::modStartNb ::$::g_modStartNb_proc |
| } | | } |
|
| | ##nagelfar syntax modStartNb x x |
| rename ::$procname ::modStartNb | | rename ::$procname ::modStartNb |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add modStartNb |
| trace add execution modStartNb enter reportTraceExecEnter | | |
| } | | |
| set ::g_modStartNb_proc $procname | | set ::g_modStartNb_proc $procname |
| } | | } |
| } | | } |
| | |
| # alternative definitions of modStartNb proc | | # alternative definitions of modStartNb proc |
| proc modStartNbProc {mod name} { | | proc modStartNbProc {mod name} { |
| # first compare against name's parent chunk by chunk | | # first compare against name's parent chunk by chunk |
| set modname [getModuleNameFromVersSpec $name] | | set modname [getModuleNameFromVersSpec $name] |
| if {$modname eq {.}} { | | if {$modname eq {.}} { |
| set i 0 | | set i 0 |
| | |
| skipping to change at line 75 | | skipping to change at line 74 |
|---|
| return $i | | return $i |
| } | | } |
| proc modStartNbProcIcase {mod name} { | | proc modStartNbProcIcase {mod name} { |
| set modname [getModuleNameFromVersSpec $name] | | set modname [getModuleNameFromVersSpec $name] |
| if {$modname eq {.}} { | | if {$modname eq {.}} { |
| set i 0 | | set i 0 |
| set imax 0 | | set imax 0 |
| } else { | | } else { |
| set namesplit [split $modname /] | | set namesplit [split $modname /] |
| set modsplit [split $mod /] | | set modsplit [split $mod /] |
|
| | ##nagelfar ignore #2 Badly formed if statement |
| set imax [if {[llength $namesplit] < [llength $modsplit]} {llength\ | | set imax [if {[llength $namesplit] < [llength $modsplit]} {llength\ |
| $namesplit} {llength $modsplit}] | | $namesplit} {llength $modsplit}] |
| for {set i 0} {$i < $imax} {incr i} { | | for {set i 0} {$i < $imax} {incr i} { |
| if {![string equal -nocase [lindex $modsplit $i] [lindex $namesplit\ | | if {![string equal -nocase [lindex $modsplit $i] [lindex $namesplit\ |
| $i]]} { | | $i]]} { |
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| if {$i == $imax && [modEq $name $mod eqstart]} { | | if {$i == $imax && [modEq $name $mod eqstart]} { |
| | |
| skipping to change at line 103 | | skipping to change at line 103 |
|---|
| set procname getEqArrayKeyProc | | set procname getEqArrayKeyProc |
| if {$impdfl} { | | if {$impdfl} { |
| append procname Impdfl | | append procname Impdfl |
| } | | } |
| | |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs getEqArrayKey] eq {} || $::g_getEqArrayKey_proc ne\ | | if {[info procs getEqArrayKey] eq {} || $::g_getEqArrayKey_proc ne\ |
| $procname} { | | $procname} { |
| if {[info exists ::g_getEqArrayKey_proc]} { | | if {[info exists ::g_getEqArrayKey_proc]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution getEqArrayKey enter reportTraceExecEnter | | initProcReportTrace remove getEqArrayKey |
| rename ::getEqArrayKey ::$::g_getEqArrayKey_proc | | rename ::getEqArrayKey ::$::g_getEqArrayKey_proc |
| } | | } |
|
| | ##nagelfar syntax getEqArrayKey x x |
| rename ::$procname ::getEqArrayKey | | rename ::$procname ::getEqArrayKey |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add getEqArrayKey |
| trace add execution getEqArrayKey enter reportTraceExecEnter | | |
| } | | |
| set ::g_getEqArrayKey_proc $procname | | set ::g_getEqArrayKey_proc $procname |
| } | | } |
| | |
| # also define modEq which is called by getEqArrayKey | | # also define modEq which is called by getEqArrayKey |
| defineModEqProc $icase $extdfl | | defineModEqProc $icase $extdfl |
| } | | } |
| | |
| # alternative definitions of getEqArrayKey proc | | # alternative definitions of getEqArrayKey proc |
| proc getEqArrayKeyProcImpdfl {arrname name} { | | proc getEqArrayKeyProcImpdfl {arrname name} { |
| set icase [isIcase] | | set icase [isIcase] |
| | |
| skipping to change at line 229 | | skipping to change at line 228 |
|---|
| # search is disabled. Define procedure on the fly to adapt its | | # search is disabled. Define procedure on the fly to adapt its |
| # code to indepth configuration option and querydepth and test mode params. | | # code to indepth configuration option and querydepth and test mode params. |
| proc defineDoesModMatchAtDepthProc {indepth querydepth test} { | | proc defineDoesModMatchAtDepthProc {indepth querydepth test} { |
| set procprops $indepth:$querydepth:$test | | set procprops $indepth:$querydepth:$test |
| | |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs doesModMatchAtDepth] eq {} ||\ | | if {[info procs doesModMatchAtDepth] eq {} ||\ |
| $::g_doesModMatchAtDepth_procprops ne $procprops} { | | $::g_doesModMatchAtDepth_procprops ne $procprops} { |
| if {[info exists ::g_doesModMatchAtDepth_procprops]} { | | if {[info exists ::g_doesModMatchAtDepth_procprops]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution doesModMatchAtDepth enter reportTraceExecEnter | | initProcReportTrace remove doesModMatchAtDepth |
| rename ::doesModMatchAtDepth {} | | rename ::doesModMatchAtDepth {} |
| } | | } |
| set ::g_doesModMatchAtDepth_procprops $procprops | | set ::g_doesModMatchAtDepth_procprops $procprops |
| | |
| # define optimized procedure | | # define optimized procedure |
| if {$indepth} { | | if {$indepth} { |
| set atdepth {$mod} | | set atdepth {$mod} |
| } else { | | } else { |
| set atdepth "\[join \[lrange \[split \$mod /\] 0 $querydepth\] /\]" | | set atdepth "\[join \[lrange \[split \$mod /\] 0 $querydepth\] /\]" |
| } | | } |
|
| | ##nagelfar syntax doesModMatchAtDepth x |
| | ##nagelfar ignore Non constant argument to proc |
| proc doesModMatchAtDepth {mod} "return \[modEqStatic $atdepth $test *\]" | | proc doesModMatchAtDepth {mod} "return \[modEqStatic $atdepth $test *\]" |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add doesModMatchAtDepth |
| trace add execution doesModMatchAtDepth enter reportTraceExecEnter | | |
| } | | |
| } | | } |
| } | | } |
| | |
| # Define procedure to check module version equals pattern. Adapt procedure | | # Define procedure to check module version equals pattern. Adapt procedure |
| # code whether icase and extended_default are enabled or disabled | | # code whether icase and extended_default are enabled or disabled |
| proc defineModVersCmpProc {icase extdfl} { | | proc defineModVersCmpProc {icase extdfl} { |
| set procname modVersCmpProc | | set procname modVersCmpProc |
| if {$icase} { | | if {$icase} { |
| append procname Icase | | append procname Icase |
| } | | } |
| if {$extdfl} { | | if {$extdfl} { |
| append procname Extdfl | | append procname Extdfl |
| } | | } |
| | |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs modVersCmp] eq {} || $::g_modVersCmp_proc ne $procname} { | | if {[info procs modVersCmp] eq {} || $::g_modVersCmp_proc ne $procname} { |
| if {[info exists ::g_modVersCmp_proc]} { | | if {[info exists ::g_modVersCmp_proc]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution modVersCmp enter reportTraceExecEnter | | initProcReportTrace remove modVersCmp |
| rename ::modVersCmp ::$::g_modVersCmp_proc | | rename ::modVersCmp ::$::g_modVersCmp_proc |
| } | | } |
|
| | ##nagelfar syntax modVersCmp x x x x x? |
| rename ::$procname ::modVersCmp | | rename ::$procname ::modVersCmp |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add modVersCmp |
| trace add execution modVersCmp enter reportTraceExecEnter | | |
| } | | |
| set ::g_modVersCmp_proc $procname | | set ::g_modVersCmp_proc $procname |
| } | | } |
| } | | } |
| | |
| # alternative definitions of modVersCmp proc | | # alternative definitions of modVersCmp proc |
| proc modVersCmpProc {cmpspec versspec modvers test {psuf {}}} { | | proc modVersCmpProc {cmpspec versspec modvers test {psuf {}}} { |
| set ret 0 | | set ret 0 |
| switch -- $cmpspec { | | switch -- $cmpspec { |
| in { | | in { |
| # check each verspec in list until match | | # check each verspec in list until match |
| | |
| skipping to change at line 294 | | skipping to change at line 292 |
|---|
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| eq { | | eq { |
| append versspec $psuf | | append versspec $psuf |
| if {$test eq {eqstart}} { | | if {$test eq {eqstart}} { |
| set ret [string equal -length [string length $versspec/]\ | | set ret [string equal -length [string length $versspec/]\ |
| $versspec/ $modvers/] | | $versspec/ $modvers/] |
| } else { | | } else { |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test $versspec $modvers] | | set ret [string $test $versspec $modvers] |
| } | | } |
| } | | } |
| ge { | | ge { |
| # as we work here on a version range: psuf suffix is ignored, checks | | # as we work here on a version range: psuf suffix is ignored, checks |
| # are always extended_default-enabled (as 1.2 includes 1.2.12 for | | # are always extended_default-enabled (as 1.2 includes 1.2.12 for |
| # instance) and equal, eqstart and match tests are equivalent | | # instance) and equal, eqstart and match tests are equivalent |
| set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ | | set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ |
| $versspec] != -1 || [string match $versspec.* $modvers])}] | | $versspec] != -1 || [string match $versspec.* $modvers])}] |
| } | | } |
| | |
| skipping to change at line 337 | | skipping to change at line 336 |
|---|
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| eq { | | eq { |
| append versspec $psuf | | append versspec $psuf |
| if {$test eq {eqstart}} { | | if {$test eq {eqstart}} { |
| set ret [string equal -nocase -length [string length $versspec/]\ | | set ret [string equal -nocase -length [string length $versspec/]\ |
| $versspec/ $modvers/] | | $versspec/ $modvers/] |
| } else { | | } else { |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test -nocase $versspec $modvers] | | set ret [string $test -nocase $versspec $modvers] |
| } | | } |
| } | | } |
| ge { | | ge { |
| set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ | | set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ |
| $versspec] != -1 || [string match -nocase $versspec.* $modvers])}] | | $versspec] != -1 || [string match -nocase $versspec.* $modvers])}] |
| } | | } |
| le { | | le { |
| set ret [expr {[isVersion $modvers] && ([versioncmp $versspec\ | | set ret [expr {[isVersion $modvers] && ([versioncmp $versspec\ |
| $modvers] != -1 || [string match -nocase $versspec.* $modvers])}] | | $modvers] != -1 || [string match -nocase $versspec.* $modvers])}] |
| | |
| skipping to change at line 375 | | skipping to change at line 375 |
|---|
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| eq { | | eq { |
| append versspec $psuf | | append versspec $psuf |
| if {$test eq {eqstart}} { | | if {$test eq {eqstart}} { |
| set ret [string equal -length [string length $versspec/]\ | | set ret [string equal -length [string length $versspec/]\ |
| $versspec/ $modvers/] | | $versspec/ $modvers/] |
| } else { | | } else { |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test $versspec $modvers] | | set ret [string $test $versspec $modvers] |
| } | | } |
| if {!$ret && [string match $versspec.* $modvers]} { | | if {!$ret && [string match $versspec.* $modvers]} { |
| set ret 1 | | set ret 1 |
| } | | } |
| } | | } |
| ge { | | ge { |
| set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ | | set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ |
| $versspec] != -1 || [string match $versspec.* $modvers])}] | | $versspec] != -1 || [string match $versspec.* $modvers])}] |
| } | | } |
| | |
| skipping to change at line 416 | | skipping to change at line 417 |
|---|
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| eq { | | eq { |
| append versspec $psuf | | append versspec $psuf |
| if {$test eq {eqstart}} { | | if {$test eq {eqstart}} { |
| set ret [string equal -nocase -length [string length $versspec/]\ | | set ret [string equal -nocase -length [string length $versspec/]\ |
| $versspec/ $modvers/] | | $versspec/ $modvers/] |
| } else { | | } else { |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test -nocase $versspec $modvers] | | set ret [string $test -nocase $versspec $modvers] |
| } | | } |
| if {!$ret && [string match -nocase $versspec.* $modvers]} { | | if {!$ret && [string match -nocase $versspec.* $modvers]} { |
| set ret 1 | | set ret 1 |
| } | | } |
| } | | } |
| ge { | | ge { |
| set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ | | set ret [expr {[isVersion $modvers] && ([versioncmp $modvers\ |
| $versspec] != -1 || [string match -nocase $versspec.* $modvers])}] | | $versspec] != -1 || [string match -nocase $versspec.* $modvers])}] |
| } | | } |
| | |
| skipping to change at line 494 | | skipping to change at line 496 |
|---|
| # modEqStatic does not compare against loaded modules so it has no need to | | # modEqStatic does not compare against loaded modules so it has no need to |
| # compare variants set on module specification | | # compare variants set on module specification |
| proc defineModEqStaticProc {icase extdfl modspec} { | | proc defineModEqStaticProc {icase extdfl modspec} { |
| set procprops $icase:$extdfl:$modspec | | set procprops $icase:$extdfl:$modspec |
| | |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs modEqStatic] eq {} || $::g_modEqStatic_procprops ne\ | | if {[info procs modEqStatic] eq {} || $::g_modEqStatic_procprops ne\ |
| $procprops} { | | $procprops} { |
| if {[info exists ::g_modEqStatic_procprops]} { | | if {[info exists ::g_modEqStatic_procprops]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution modEqStatic enter reportTraceExecEnter | | initProcReportTrace remove modEqStatic |
| rename ::modEqStatic {} | | rename ::modEqStatic {} |
| } else { | | } else { |
| # also define modVersCmp which is called by modEqStatic | | # also define modVersCmp which is called by modEqStatic |
| defineModVersCmpProc $icase $extdfl | | defineModVersCmpProc $icase $extdfl |
| } | | } |
| set ::g_modEqStatic_procprops $procprops | | set ::g_modEqStatic_procprops $procprops |
| | |
| # define optimized procedure | | # define optimized procedure |
| lassign [getModuleVersSpec $modspec] pmod pmodname cmpspec versspec\ | | lassign [getModuleVersSpec $modspec] pmod pmodname cmpspec versspec\ |
| pmodnamere pmodescglob | | pmodnamere pmodescglob |
| | |
| skipping to change at line 571 | | skipping to change at line 573 |
|---|
| set modvers \[string range \$mod \[string length \$pmodname/\]\ | | set modvers \[string range \$mod \[string length \$pmodname/\]\ |
| end\] | | end\] |
| set ret \[modVersCmp {$cmpspec} {$versspec} \$modvers \$test\ | | set ret \[modVersCmp {$cmpspec} {$versspec} \$modvers \$test\ |
| \$psuf\] | | \$psuf\] |
| } else { | | } else { |
| set ret 0 | | set ret 0 |
| }" | | }" |
| } | | } |
| append procbody " | | append procbody " |
| return \$ret" | | return \$ret" |
|
| | ##nagelfar syntax modEqStatic x x? x? |
| | ##nagelfar ignore Non constant argument to proc |
| proc modEqStatic {mod {test equal} {psuf {}}} $procbody | | proc modEqStatic {mod {test equal} {psuf {}}} $procbody |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add modEqStatic |
| trace add execution modEqStatic enter reportTraceExecEnter | | |
| } | | |
| } | | } |
| } | | } |
| | |
| # Define procedure to check module name equals pattern. Adapt procedure | | # Define procedure to check module name equals pattern. Adapt procedure |
| # code whether icase and extended_default are enabled or disabled | | # code whether icase and extended_default are enabled or disabled |
| proc defineModEqProc {icase extdfl {loadedmod 0}} { | | proc defineModEqProc {icase extdfl {loadedmod 0}} { |
| set procname modEqProc | | set procname modEqProc |
| if {$icase} { | | if {$icase} { |
| append procname Icase | | append procname Icase |
| } | | } |
| if {$extdfl} { | | if {$extdfl} { |
| append procname Extdfl | | append procname Extdfl |
| } | | } |
| | |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs modEq] eq {} || $::g_modEq_proc ne $procname} { | | if {[info procs modEq] eq {} || $::g_modEq_proc ne $procname} { |
| if {[info exists ::g_modEq_proc]} { | | if {[info exists ::g_modEq_proc]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution modEq enter reportTraceExecEnter | | initProcReportTrace remove modEq |
| rename ::modEq ::$::g_modEq_proc | | rename ::modEq ::$::g_modEq_proc |
| } | | } |
|
| | ##nagelfar syntax modEq x x x? x? x? x? x? x? |
| rename ::$procname ::modEq | | rename ::$procname ::modEq |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add modEq |
| trace add execution modEq enter reportTraceExecEnter | | |
| } | | |
| set ::g_modEq_proc $procname | | set ::g_modEq_proc $procname |
| } | | } |
| | |
| # also define modVersCmp which is called by modEq | | # also define modVersCmp which is called by modEq |
| defineModVersCmpProc $icase $extdfl | | defineModVersCmpProc $icase $extdfl |
| | |
| # comparing against loaded modules requires to know their alternative names | | # comparing against loaded modules requires to know their alternative names |
| if {$loadedmod} { | | if {$loadedmod} { |
| cacheCurrentModules | | cacheCurrentModules |
| } | | } |
| | |
| skipping to change at line 671 | | skipping to change at line 672 |
|---|
| } | | } |
| } | | } |
| } else { | | } else { |
| # contains test | | # contains test |
| if {$test eq {matchin}} { | | if {$test eq {matchin}} { |
| set test match | | set test match |
| set pmod *$pmod | | set pmod *$pmod |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| set test equal | | set test equal |
| } | | } |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test $pmod $mod] | | set ret [string $test $pmod $mod] |
| # apply comparison to alternative names if any and no match for mod | | # apply comparison to alternative names if any and no match for mod |
| if {!$ret && [llength $altlist] > 0} { | | if {!$ret && [llength $altlist] > 0} { |
| foreach alt $altlist { | | foreach alt $altlist { |
|
| | ##nagelfar ignore Non static subcommand |
| if {[set ret [string $test $pmod $alt]]} { | | if {[set ret [string $test $pmod $alt]]} { |
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| # test equality against all version described in spec (list or range | | # test equality against all version described in spec (list or range |
| # boundaries), trspec is considered enabled and psuf empty | | # boundaries), trspec is considered enabled and psuf empty |
| foreach pmod [getAllModulesFromVersSpec $pattern] { | | foreach pmod [getAllModulesFromVersSpec $pattern] { |
| | |
| skipping to change at line 789 | | skipping to change at line 792 |
|---|
| } | | } |
| } | | } |
| } else { | | } else { |
| # contains test | | # contains test |
| if {$test eq {matchin}} { | | if {$test eq {matchin}} { |
| set test match | | set test match |
| set pmod *$pmod | | set pmod *$pmod |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| set test equal | | set test equal |
| } | | } |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test -nocase $pmod $mod] | | set ret [string $test -nocase $pmod $mod] |
| if {!$ret && [llength $altlist] > 0} { | | if {!$ret && [llength $altlist] > 0} { |
| foreach alt $altlist { | | foreach alt $altlist { |
|
| | ##nagelfar ignore Non static subcommand |
| if {[set ret [string $test -nocase $pmod $alt]]} { | | if {[set ret [string $test -nocase $pmod $alt]]} { |
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| # test equality against all version described in spec (list or range | | # test equality against all version described in spec (list or range |
| # boundaries), trspec is considered enabled and psuf empty | | # boundaries), trspec is considered enabled and psuf empty |
| foreach pmod [getAllModulesFromVersSpec $pattern] { | | foreach pmod [getAllModulesFromVersSpec $pattern] { |
| | |
| skipping to change at line 903 | | skipping to change at line 908 |
|---|
| } | | } |
| } else { | | } else { |
| # contains test | | # contains test |
| if {$test eq {matchin}} { | | if {$test eq {matchin}} { |
| set test match | | set test match |
| set pmod *$pmod | | set pmod *$pmod |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| set test equal | | set test equal |
| set eqspec 1 | | set eqspec 1 |
| } | | } |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test $pmod $mod] | | set ret [string $test $pmod $mod] |
| if {!$ret && [llength $altlist] > 0} { | | if {!$ret && [llength $altlist] > 0} { |
| foreach alt $altlist { | | foreach alt $altlist { |
|
| | ##nagelfar ignore Non static subcommand |
| if {[set ret [string $test $pmod $alt]]} { | | if {[set ret [string $test $pmod $alt]]} { |
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| # try the extended default match if not root module and not eqspec test | | # try the extended default match if not root module and not eqspec test |
| if {![info exists eqspec] && !$ret && [string first / $pmod] != -1} { | | if {![info exists eqspec] && !$ret && [string first / $pmod] != -1} { |
| if {$test eq {match}} { | | if {$test eq {match}} { |
| set pmodextdfl $pmod.* | | set pmodextdfl $pmod.* |
| | |
| skipping to change at line 1034 | | skipping to change at line 1041 |
|---|
| } | | } |
| } else { | | } else { |
| # contains test | | # contains test |
| if {$test eq {matchin}} { | | if {$test eq {matchin}} { |
| set test match | | set test match |
| set pmod *$pmod | | set pmod *$pmod |
| } elseif {$test eq {eqspec}} { | | } elseif {$test eq {eqspec}} { |
| set test equal | | set test equal |
| set eqspec 1 | | set eqspec 1 |
| } | | } |
|
| | ##nagelfar ignore Non static subcommand |
| set ret [string $test -nocase $pmod $mod] | | set ret [string $test -nocase $pmod $mod] |
| if {!$ret && [llength $altlist] > 0} { | | if {!$ret && [llength $altlist] > 0} { |
| foreach alt $altlist { | | foreach alt $altlist { |
|
| | ##nagelfar ignore Non static subcommand |
| if {[set ret [string $test -nocase $pmod $alt]]} { | | if {[set ret [string $test -nocase $pmod $alt]]} { |
| break | | break |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| # try the extended default match if not root module and not eqspec test | | # try the extended default match if not root module and not eqspec test |
| if {![info exists eqspec] && !$ret && [string first / $pmod] != -1} { | | if {![info exists eqspec] && !$ret && [string first / $pmod] != -1} { |
| if {$test eq {match}} { | | if {$test eq {match}} { |
| set pmodextdfl $pmod.* | | set pmodextdfl $pmod.* |
| | |
| skipping to change at line 1186 | | skipping to change at line 1195 |
|---|
| if {$advverspec} { | | if {$advverspec} { |
| append procname AdvVersSpec | | append procname AdvVersSpec |
| # resolved configured variant shortcut | | # resolved configured variant shortcut |
| getConf variant_shortcut | | getConf variant_shortcut |
| } | | } |
| # define proc if not done yet or if it was defined for another context | | # define proc if not done yet or if it was defined for another context |
| if {[info procs parseModuleSpecification] eq {} ||\ | | if {[info procs parseModuleSpecification] eq {} ||\ |
| $::g_parseModuleSpecification_proc ne $procname} { | | $::g_parseModuleSpecification_proc ne $procname} { |
| if {[info exists ::g_parseModuleSpecification_proc]} { | | if {[info exists ::g_parseModuleSpecification_proc]} { |
| # remove existing debug trace if any | | # remove existing debug trace if any |
|
| trace remove execution parseModuleSpecification enter\ | | initProcReportTrace remove parseModuleSpecification |
| reportTraceExecEnter | | |
| rename ::parseModuleSpecification\ | | rename ::parseModuleSpecification\ |
| ::$::g_parseModuleSpecification_proc | | ::$::g_parseModuleSpecification_proc |
| } | | } |
|
| | ##nagelfar syntax parseModuleSpecification x x* |
| rename ::$procname ::parseModuleSpecification | | rename ::$procname ::parseModuleSpecification |
|
| # set debug trace if verbosity is set to debug2 or higher | | # set report traces if some debug mode enabled |
| if {[isVerbosityLevel debug2]} { | | initProcReportTrace add parseModuleSpecification |
| trace add execution parseModuleSpecification enter\ | | |
| reportTraceExecEnter | | |
| } | | |
| set ::g_parseModuleSpecification_proc $procname | | set ::g_parseModuleSpecification_proc $procname |
| } | | } |
| } | | } |
| | |
| # when advanced_version_spec option is enabled, parse argument list to set in | | # when advanced_version_spec option is enabled, parse argument list to set in |
| # a global context version specification of modules passed as argument. | | # a global context version specification of modules passed as argument. |
| # specification may vary whether it comes from the ml or another command. | | # specification may vary whether it comes from the ml or another command. |
| proc parseModuleSpecificationProc {mlspec args} { | | proc parseModuleSpecificationProc {mlspec args} { |
| # skip arg parse if proc was already call with same arg set by an upper | | # skip arg parse if proc was already call with same arg set by an upper |
| # proc. check all args to ensure current arglist does not deviate from | | # proc. check all args to ensure current arglist does not deviate from |
| | |
| skipping to change at line 1236 | | skipping to change at line 1242 |
|---|
| set modname $arg | | set modname $arg |
| set mlunload 0 | | set mlunload 0 |
| } | | } |
| # keep arg enclosed if composed of several words | | # keep arg enclosed if composed of several words |
| if {[string first { } $modname] != -1} { | | if {[string first { } $modname] != -1} { |
| set modarg "{$modname}" | | set modarg "{$modname}" |
| } else { | | } else { |
| set modarg $modname | | set modarg $modname |
| } | | } |
| # record spec, especially needed if arg is enclosed | | # record spec, especially needed if arg is enclosed |
|
| setModuleVersSpec $modarg $modname eq {} {} {} | | setModuleVersSpec $modarg $modname eq {} {} {} $arg |
| # append to unload list if ml spec and - prefix used | | # append to unload list if ml spec and - prefix used |
| if {$mlunload} { | | if {$mlunload} { |
| lappend unarglist $modarg | | lappend unarglist $modarg |
| } else { | | } else { |
| lappend arglist $modarg | | lappend arglist $modarg |
| } | | } |
| } | | } |
| | |
| if {$mlspec} { | | if {$mlspec} { |
| return [list $unarglist $arglist] | | return [list $unarglist $arglist] |
| | |
| skipping to change at line 1269 | | skipping to change at line 1275 |
|---|
| if {![info exists need_parse]} { | | if {![info exists need_parse]} { |
| return $args | | return $args |
| } | | } |
| | |
| set mlunload 0 | | set mlunload 0 |
| set nextmlunload 0 | | set nextmlunload 0 |
| set arglist [list] | | set arglist [list] |
| set unarglist [list] | | set unarglist [list] |
| set vrlist [list] | | set vrlist [list] |
| set vridx -1 | | set vridx -1 |
|
| | set rawarg [list] |
| foreach arg $args { | | foreach arg $args { |
| # set each specification element as separate word but preserve space | | # set each specification element as separate word but preserve space |
| # character in each arg | | # character in each arg |
| set previ 0 | | set previ 0 |
| set curarglist {} | | set curarglist {} |
| for {set i 1} {$i < [string length $arg]} {incr i} { | | for {set i 1} {$i < [string length $arg]} {incr i} { |
| set c [string index $arg $i] | | set c [string index $arg $i] |
| switch -- $c { | | switch -- $c { |
| @ - ~ { | | @ - ~ { |
| lappend curarglist [string range $arg $previ [expr {$i - 1}]] | | lappend curarglist [string range $arg $previ [expr {$i - 1}]] |
| | |
| skipping to change at line 1299 | | skipping to change at line 1306 |
|---|
| lappend curarglist [string range $arg $previ [expr\ | | lappend curarglist [string range $arg $previ [expr\ |
| {$i - 1}]] | | {$i - 1}]] |
| set previ $i | | set previ $i |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| default { | | default { |
| # check if a variant shortcut matches | | # check if a variant shortcut matches |
| if {[info exists ::g_shortcutVariant($c)]} { | | if {[info exists ::g_shortcutVariant($c)]} { |
|
| lappend curarglist [string range $arg $previ [expr {$i - 1}]] | | lappend curarglist [string range $arg $previ [expr {$i -\ |
| | 1}]] |
| set previ $i | | set previ $i |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| lappend curarglist [string range $arg $previ [expr {$i - 1}]] | | lappend curarglist [string range $arg $previ [expr {$i - 1}]] |
| | |
| # parse each specification element | | # parse each specification element |
| foreach curarg $curarglist { | | foreach curarg $curarglist { |
| set vrisbool 0 | | set vrisbool 0 |
| | |
| skipping to change at line 1386 | | skipping to change at line 1394 |
|---|
| # save previous mod version spec and transformed arg if any | | # save previous mod version spec and transformed arg if any |
| if {[info exists modarglist]} { | | if {[info exists modarglist]} { |
| set modarg [join $modarglist] | | set modarg [join $modarglist] |
| if {![info exists cmpspec]} { | | if {![info exists cmpspec]} { |
| set cmpspec eq | | set cmpspec eq |
| set versspec {} | | set versspec {} |
| } | | } |
| if {[info exists modname] && ($modname ne {} || $modspec\ | | if {[info exists modname] && ($modname ne {} || $modspec\ |
| eq {})} { | | eq {})} { |
| setModuleVersSpec $modarg $modname $cmpspec $versspec\ | | setModuleVersSpec $modarg $modname $cmpspec $versspec\ |
|
| $modspec $vrlist | | $modspec $vrlist $rawarg |
| # rework args to have 1 str element for whole mod spec | | # rework args to have 1 str element for whole mod spec |
| # append to unload list if ml spec and - prefix used | | # append to unload list if ml spec and - prefix used |
| if {$mlunload} { | | if {$mlunload} { |
| lappend unarglist $modarg | | lappend unarglist $modarg |
| } else { | | } else { |
| lappend arglist $modarg | | lappend arglist $modarg |
| } | | } |
| } else { | | } else { |
| knerror "No module name defined in argument '$modarg'" | | knerror "No module name defined in argument '$modarg'" |
| } | | } |
| unset modarglist | | unset modarglist |
| set vrlist [list] | | set vrlist [list] |
| array unset vrnamearr | | array unset vrnamearr |
| set vridx -1 | | set vridx -1 |
|
| | set rawarg [list] |
| unset cmpspec versspec | | unset cmpspec versspec |
| } | | } |
| set mlunload $nextmlunload | | set mlunload $nextmlunload |
| set nextmlunload 0 | | set nextmlunload 0 |
| set modname $curarg | | set modname $curarg |
| set modspec {} | | set modspec {} |
| } | | } |
| } | | } |
| } | | } |
|
| | lappend rawarg $arg |
| | |
| # keep arg enclosed if composed of several words | | # keep arg enclosed if composed of several words |
| if {[string first { } $arg] != -1} { | | if {[string first { } $arg] != -1} { |
| lappend modarglist "{$arg}" | | lappend modarglist "{$arg}" |
| } else { | | } else { |
| lappend modarglist $arg | | lappend modarglist $arg |
| } | | } |
| } | | } |
| # transform last args | | # transform last args |
| set modarg [join $modarglist] | | set modarg [join $modarglist] |
| if {[info exists modname] && ($modname ne {} || $modspec eq {})} { | | if {[info exists modname] && ($modname ne {} || $modspec eq {})} { |
| if {![info exists cmpspec]} { | | if {![info exists cmpspec]} { |
| set cmpspec eq | | set cmpspec eq |
| set versspec {} | | set versspec {} |
| } | | } |
|
| setModuleVersSpec $modarg $modname $cmpspec $versspec $modspec $vrlist | | setModuleVersSpec $modarg $modname $cmpspec $versspec $modspec $vrlist\ |
| | $rawarg |
| # rework args to have 1 string element for whole module spec | | # rework args to have 1 string element for whole module spec |
| # append to unload list if ml spec and - prefix used | | # append to unload list if ml spec and - prefix used |
| if {$mlunload || $nextmlunload} { | | if {$mlunload || $nextmlunload} { |
| lappend unarglist $modarg | | lappend unarglist $modarg |
| } else { | | } else { |
| lappend arglist $modarg | | lappend arglist $modarg |
| } | | } |
| } else { | | } else { |
| knerror "No module name defined in argument '$modarg'" | | knerror "No module name defined in argument '$modarg'" |
| } | | } |
| | |
| if {$mlspec} { | | if {$mlspec} { |
| return [list $unarglist $arglist] | | return [list $unarglist $arglist] |
| } else { | | } else { |
| return $arglist | | return $arglist |
| } | | } |
| } | | } |
| | |
| proc setModuleVersSpec {modarg modname cmpspec versspec rawversspec\ | | proc setModuleVersSpec {modarg modname cmpspec versspec rawversspec\ |
|
| variantlist} { | | variantlist rawarg} { |
| # translate @loaded version into currently loaded mod matching modname | | # translate @loaded version into currently loaded mod matching modname |
| if {$cmpspec eq {eq} && $versspec eq {loaded}} { | | if {$cmpspec eq {eq} && $versspec eq {loaded}} { |
| if {[set lmmod [getLoadedMatchingName $modname]] ne {}} { | | if {[set lmmod [getLoadedMatchingName $modname]] ne {}} { |
| set modname [file dirname $lmmod] | | set modname [file dirname $lmmod] |
| set versspec [file tail $lmmod] | | set versspec [file tail $lmmod] |
| set variantlist [getVariantList $lmmod 2] | | set variantlist [getVariantList $lmmod 2] |
| } else { | | } else { |
| knerror "No loaded version found for '$modname' module" | | knerror "No loaded version found for '$modname' module" |
| } | | } |
| } | | } |
| | |
| skipping to change at line 1490 | | skipping to change at line 1501 |
|---|
| # save module name and version specification (without variant specs) | | # save module name and version specification (without variant specs) |
| if {$mod eq {} && $rawversspec ne {} && $modname ne {.}} { | | if {$mod eq {} && $rawversspec ne {} && $modname ne {.}} { |
| set modnvspec ${modname}@${rawversspec} | | set modnvspec ${modname}@${rawversspec} |
| } else { | | } else { |
| set modnvspec $mod | | set modnvspec $mod |
| } | | } |
| | |
| reportDebug "Set module '$mod' (escglob '$modescglob'), module name\ | | reportDebug "Set module '$mod' (escglob '$modescglob'), module name\ |
| '$modname' (re '$modnamere'), module root '$modroot', version cmp\ | | '$modname' (re '$modnamere'), module root '$modroot', version cmp\ |
| '$cmpspec', version(s) '$versspec', variant(s) '$variantlist' and\ | | '$cmpspec', version(s) '$versspec', variant(s) '$variantlist' and\ |
|
| module name version spec '$modnvspec' for argument '$modarg'" | | module name version spec '$modnvspec' for argument '$modarg' (raw\ |
| | '$rawarg')" |
| set ::g_moduleVersSpec($modarg) [list $mod $modname $cmpspec $versspec\ | | set ::g_moduleVersSpec($modarg) [list $mod $modname $cmpspec $versspec\ |
|
| $modnamere $modescglob $modroot $variantlist $modnvspec] | | $modnamere $modescglob $modroot $variantlist $modnvspec $rawarg] |
| } | | } |
| | |
| proc getModuleVersSpec {modarg} { | | proc getModuleVersSpec {modarg} { |
| if {[info exists ::g_moduleVersSpec($modarg)]} { | | if {[info exists ::g_moduleVersSpec($modarg)]} { |
| return $::g_moduleVersSpec($modarg) | | return $::g_moduleVersSpec($modarg) |
| } else { | | } else { |
| return [list $modarg [file dirname $modarg] {} {} {} [string map {* \\*\ | | return [list $modarg [file dirname $modarg] {} {} {} [string map {* \\*\ |
|
| ? \\?} $modarg] [lindex [file split $modarg] 0] {} $modarg] | | ? \\?} $modarg] [lindex [file split $modarg] 0] {} $modarg $modarg] |
| | } |
| | } |
| | |
| | proc unsetModuleVersSpec {modarg} { |
| | if {[info exists ::g_moduleVersSpec($modarg)]} { |
| | unset ::g_moduleVersSpec($modarg) |
| } | | } |
| } | | } |
| | |
| # get module name from module name and version spec if parsed | | # get module name from module name and version spec if parsed |
| proc getModuleNameFromVersSpec {modarg} { | | proc getModuleNameFromVersSpec {modarg} { |
| if {[info exists ::g_moduleVersSpec($modarg)]} { | | if {[info exists ::g_moduleVersSpec($modarg)]} { |
| lassign $::g_moduleVersSpec($modarg) mod modname | | lassign $::g_moduleVersSpec($modarg) mod modname |
| } else { | | } else { |
| set modname [file dirname $modarg] | | set modname [file dirname $modarg] |
| } | | } |
| | |
| skipping to change at line 1589 | | skipping to change at line 1607 |
|---|
| # get module name and version from version spec if parsed | | # get module name and version from version spec if parsed |
| proc getModuleNameAndVersFromVersSpec {modarg} { | | proc getModuleNameAndVersFromVersSpec {modarg} { |
| if {[info exists ::g_moduleVersSpec($modarg)]} { | | if {[info exists ::g_moduleVersSpec($modarg)]} { |
| set modnvspec [lindex $::g_moduleVersSpec($modarg) 8] | | set modnvspec [lindex $::g_moduleVersSpec($modarg) 8] |
| } else { | | } else { |
| set modnvspec $modarg | | set modnvspec $modarg |
| } | | } |
| return $modnvspec | | return $modnvspec |
| } | | } |
| | |
|
| | # get raw argument specified from parsed version spec |
| | proc getRawArgumentFromVersSpec {modarg} { |
| | if {[info exists ::g_moduleVersSpec($modarg)]} { |
| | set rawarg [lindex $::g_moduleVersSpec($modarg) 9] |
| | } else { |
| | set rawarg $modarg |
| | } |
| | return $rawarg |
| | } |
| | |
| # ;;; Local Variables: *** | | # ;;; Local Variables: *** |
| # ;;; mode:tcl *** | | # ;;; mode:tcl *** |
| # ;;; End: *** | | # ;;; End: *** |
| # vim:set tabstop=3 shiftwidth=3 expandtab autoindent: | | # vim:set tabstop=3 shiftwidth=3 expandtab autoindent: |
| | | |
| End of changes. 46 change blocks. |
|---|
| 45 lines changed or deleted | | 73 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 