Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the correct answer then.

Also backport genStubs.tcl from 8.7: The "deprecated" mark is not used in Tcl 8.6, but it is used by Tk 8.7 when doing "make genstubs" against Tcl 8.6.

5 files changed, 41 insertions, 20 deletions

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 0377064..e8933d6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -23,7 +23,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
 testConstraint testvolumetype  [llength [info commands testvolumetype]]
 testConstraint linkDirectory [expr {
     ![testConstraint win] ||
-    ([string index $tcl_platform(osVersion) 0] >= 5
+    ($::tcl_platform(osVersion) >= 5.0
      && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
 }]
 
diff --git a/tests/fCmd.test b/tests/fCmd.test
index c8264b2..11ab79e 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -65,11 +65,10 @@ if {[testConstraint unix]} {
 
 # Also used in winFCmd...
 if {[testConstraint win]} {
-    set major [string index $tcl_platform(osVersion) 0]
-    if {[testConstraint nt] && $major > 4} {
-        if {$major > 5} {
+    if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
+        if {$::tcl_platform(osVersion) >= 6.0} {
             testConstraint winVista 1
-        } elseif {$major == 5} {
+        } else {
             testConstraint win2000orXP 1
         }
     }
@@ -78,7 +77,7 @@ if {[testConstraint win]} {
 testConstraint darwin9 [expr {
     [testConstraint unix]
     && $tcl_platform(os) eq "Darwin"
-    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
+    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
 }]
 testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
 
@@ -2309,7 +2308,7 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
 
 if {
     [testConstraint win] &&
-    ([string index $tcl_platform(osVersion) 0] < 5
+    ($::tcl_platform(osVersion) < 5.0
      || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
 } then {
     testConstraint linkDirectory 0
diff --git a/tests/fileName.test b/tests/fileName.test
index 7f983a7..7b51da1 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -23,7 +23,7 @@ testConstraint testtranslatefilename [llength [info commands testtranslatefilena
 testConstraint linkDirectory 1
 testConstraint symbolicLinkFile 1
 if {[testConstraint win]} {
-    if {[string index $tcl_platform(osVersion) 0] < 5 \
+    if {$::tcl_platform(osVersion) < 5.0 \
 	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
 	testConstraint linkDirectory 0
     }
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 28a08fb..5243eca 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -57,11 +57,10 @@ proc cleanup {args} {
 }
 
 if {[testConstraint winOnly]} {
-    set major [string index $tcl_platform(osVersion) 0]
-    if {[testConstraint nt] && $major > 4} {
-        if {$major > 5} {
+    if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
+        if {$::tcl_platform(osVersion) >= 6.0} {
             testConstraint winVista 1
-        } elseif {$major == 5} {
+        } else {
             testConstraint win2000orXP 1
         }
     } else {
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 9f2c6ca..830ba2b 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -191,12 +191,21 @@ proc genStubs::declare {args} {
     regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
     set decl [parseDecl $decl]
 
-    foreach platform $platformList {
-	if {$decl ne ""} {
-	    set stubs($curName,$platform,$index) $decl
-	    if {![info exists stubs($curName,$platform,lastNum)] \
-		    || ($index > $stubs($curName,$platform,lastNum))} {
-		set stubs($curName,$platform,lastNum) $index
+    if {([lindex $platformList 0] eq "deprecated")} {
+	set stubs($curName,deprecated,$index) [lindex $platformList 1]
+	set stubs($curName,generic,$index) $decl
+	if {![info exists stubs($curName,generic,lastNum)] \
+		|| ($index > $stubs($curName,generic,lastNum))} {
+	    set stubs($curName,generic,lastNum) $index
+	}
+    } else {
+	foreach platform $platformList {
+	    if {$decl ne ""} {
+		set stubs($curName,$platform,$index) $decl
+		    if {![info exists stubs($curName,$platform,lastNum)] \
+			    || ($index > $stubs($curName,$platform,lastNum))} {
+			set stubs($curName,$platform,lastNum) $index
+		}
 	    }
 	}
     }
@@ -455,10 +464,17 @@ proc genStubs::parseArg {arg} {
 
 proc genStubs::makeDecl {name decl index} {
     variable scspec
+    variable stubs
+    variable libraryName
     lassign $decl rtype fname args
 
     append text "/* $index */\n"
-    set line "$scspec $rtype"
+    if {[info exists stubs($name,deprecated,$index)]} {
+	append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
+	set line "$rtype"
+    } else {
+	set line "$scspec $rtype"
+    }
     set count [expr {2 - ([string length $line] / 8)}]
     append line [string range "\t\t\t" 0 $count]
     set pad [expr {24 - [string length $line]}]
@@ -569,11 +585,15 @@ proc genStubs::makeMacro {name decl index} {
 
 proc genStubs::makeSlot {name decl index} {
     lassign $decl rtype fname args
+    variable stubs
 
     set lfname [string tolower [string index $fname 0]]
     append lfname [string range $fname 1 end]
 
     set text "    "
+    if {[info exists stubs($name,deprecated,$index)]} {
+	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
+    }
     if {$args eq ""} {
 	append text $rtype " *" $lfname "; /* $index */\n"
 	return $text
@@ -682,7 +702,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
 	for {set i 0} {$i <= $lastNum} {incr i} {
 	    set slots [array names stubs $name,*,$i]
 	    set emit 0
-	    if {[info exists stubs($name,generic,$i)]} {
+	    if {[info exists stubs($name,deprecated,$i)]} {
+		append text [$slotProc $name $stubs($name,generic,$i) $i]
+		set emit 1
+	    } elseif {[info exists stubs($name,generic,$i)]} {
 		if {[llength $slots] > 1} {
 		    puts stderr "conflicting generic and platform entries:\
 			    $name $i"