Version 6 of Detecting the Tcl implementation in use

Updated 2016-02-03 04:30:14 by mistachkin

Prior to the introduction of TIP #440 , detecting the Tcl implementation (a.k.a. "engine") in use could be a bit complex. Ironically, detecting Tcl itself was the toughest job of all, especially for versions less than 8.6. The following script demonstrates how this could have been accomplished. If TIP #440 support is present, it will be used; otherwise, detection heuristics that are somewhat more complex will be used. Perhaps this should be added to tcllib, I don't know (if so, it would need to be in its own file).

#
# Created by Joe Mistachkin on January 27th, 2016.
# Dedicated to the Public Domain.
#
# NOTE: This is a script to detect the engine (a.k.a. implementation) of
#       Tcl being used.  Here are the underlying assumptions and rules:
#
#       0. If TIP 440 support is present, the checking is trivial.
#
#       1. The interpreter instance being checked has its standard set of
#          commands and variables.  Ideally, it should be freshly created.
#
#       2. The [detectEngine] procedure should not raise uncaught script
#          errors in any recognized implementation.
#
#       3. The [detectEngine] procedure should not cause any recognized
#          implementation to crash or hang.
#
#       4. The [detectEngine] procedure should not rely on undefined or
#          undocumented behavior of any recognized implementation.
#
#       5. The [detectEngine] procedure should not add, modify, or remove
#          any global variables.  Furthermore, it should remove any extra
#          procedures added during its evaluation.
#
#       6. All recognized implementations must support array variables -OR-
#          scalar variables that look like array elements for, both for use
#          with [info exists] and the "$" syntax.
#
#       7. All recognized implementations should support (or correctly fake)
#          infix expressions with at least the following subset of operators:
#
#                                      ==
#                                      &&
#                                      >=
#                                      >
#                                      ||
#
#          There are cases where some of these operators may not be needed,
#          e.g. "&&" when the implementation was detected before that point
#          in the [detectEngine] procedure.  It should be noted that several
#          recognized implementations (e.g. TH1 and Picol) do not support
#          operator short-circuiting (e.g. "&&", etc).  Additionally, Picol
#          cannot handle expressions containing more than one operator.
#
#       8. All recognized implementations should support at the following
#          subset of commands and sub-commands:
#
#                 [proc name args body]
#                 [if expr1 body1]; # NOTE: No "then" clauses.
#                 [info exists varName]
#                 [return value]
#                 [set varName varValue]
#                 [catch script ?varName?]
#                 [llength list]
#                 [info commands name]
#                 [clock seconds]
#                 [rename oldName newName]
#                 [string trim string]
#                 [info vars pattern]
#                 [package versions package]
#
#          There are cases where some of these commands may not be needed,
#          e.g. [clock seconds] when the implementation was detected prior
#          to that point in the [detectEngine] procedure.
#
#          Additional commands and sub-commands may be used within some of
#          the [if] blocks -OR- after checking for all implementations
#          recognized to be minimalist (i.e. where the chance is quite high
#          that they are available).
#
#       9. No implementation of Tcl, other than Tcl itself, claims to be
#          version 8.6 or higher, as of January 2016.
#
#      10. Only Tcl itself has BigNum support, version 8.5 and higher, as
#          of January 2016.
#
#      11. Only Tcl itself has a bytecode compiler, version 8.0 and higher,
#          as of January 2016.
#
#      12. The recognized implementations are:
#
#                 Eagle, all versions (verified)
#                 TH1, all versions (verified)
#                 Jim, all versions (verified)
#                 JTcl, version 2.7.0+ (verified)
#                 Jacl, version 1.3.2+ (verified)
#                 Picol, version 0.1.22+ (verified)
#
#                 Tcl, version 8.4, without TIP 440 (verified)
#                 Tcl, version 8.5, with TIP 440 (verified)
#                 Tcl, version 8.5, without TIP 440 (verified)
#                 Tcl, version 8.6+, with TIP 440 (verified)
#                 Tcl, version 8.6+, without TIP 440 (verified)
#
#          Detection of Tcl itself, versions from 8.0 to 8.3, will probably
#          work; however, it has not been tested.
#
#      13. Feel free to improve this by making it more robust, recognizing
#          more implementations (or versions thereof), or fixing mistakes.
#
proc detectEngine {} {
  #
  # NOTE: The following [if] block must not cause an error in any recognized
  #       implementation.
  #
  if {[info exists ::tcl_platform(engine)]} {
    return $::tcl_platform(engine)
  }

  #
  # HACK: This must be first because both TH1 and Picol lack support for
  #       the "then" clause; however, only Picol has the [_l] command.
  #       The "&&" operator cannot be used here.  So, nested [if] blocks
  #       are used instead.
  #
  set code [catch {llength [info commands _l]} result]
  if {$code == 0} {if {$result == 1} {return Picol}}

  #
  # HACK: This must be second because there are a number of constructs
  #       used beyond this point that TH1 cannot handle.  This works by
  #       checking for a lack of "then" clause support.  This cannot be
  #       Picol, because that was already checked above; therefore, it
  #       must be TH1.
  #
  if {[catch {if {1} then {}}] == 1} {
    return TH1
  }

  #
  # NOTE: Check for Tcl version 8.6 or higher.  If this is true, it can
  #       only be Tcl itself, as of January 2016.
  #
  if {[info exists ::tcl_version] && $::tcl_version >= 8.6} {
    return Tcl
  }

  #
  # NOTE: Check for Tcl version 8.5 or higher.  If this is true, we can
  #       check for BigNum support as that is found only in Tcl itself,
  #       as of January 2016.
  #
  if {[info exists ::tcl_version] && $::tcl_version >= 8.5} {
    set code [catch {
      if {1 << 99 == 633825300114114700748351602688} {
        return 1
      } else {
        return 0
      }
    } result]

    if {$code == 2 && $result == 1} {
      return Tcl
    }
  }

  #
  # HACK: Check for Tcl version 8.0 or higher.  If this is true, then
  #       we can (indirectly) check for the bytecode compiler.  This
  #       uses a "dirty trick" (i.e. the entire procedure is compiled,
  #       which will cause a script compilation error in Tcl 8.0, 8.1,
  #       8.2, 8.3, and 8.4 because they lack the "in" operator.
  #
  if {[info exists ::tcl_version] && $::tcl_version >= 8.0} {
    set procName __detect__tcl8x__bc__[clock seconds]

    set code [catch {
      proc $procName { arg } {
        if {$arg} {
          return $arg
        } else {
          if {1 in "1 2 3"} {
            return 2
          } else {
            return 3
          }
        }
      }

      $procName 1
    } result]

    catch {rename $procName {}}; # NOTE: Just in case.

    set error [string trim {
      syntax error in expression "1 in "1 2 3"":\
      extra tokens at end of expression
    }]

    if {$code == 1 && $result == $error} {
      return Tcl
    }
  }

  #
  # NOTE: All versions of Eagle have the $::eagle_platform array.  Also,
  #       all versions of Eagle have the [nop] command.
  #
  if {[info exists ::eagle_platform] || \
      [llength [info commands nop]] == 1} {
    return Eagle
  }

  #
  # NOTE: It appears that all versions of Jim have the [ref] command.
  #
  if {[llength [info vars jim::*]] > 0 || \
      [llength [info commands ref]] == 1} {
    return Jim
  }

  #
  # NOTE: Both Jacl and JTcl provide a package named "java".  No other
  #       recognized implementation of Tcl provides this package in a
  #       freshly created interpreter, as of January 2016.
  #
  if {[llength [package versions java]] > 0} {
    #
    # NOTE: Only JTcl has the [apply] and [lset] commands.
    #
    if {[llength [info commands apply]] == 1 || \
        [llength [info commands lset]] == 1} {
      return JTcl
    }

    return Jacl
  }

  return unknown; # TODO: No idea, improve me?
}

###############################################################################
#
# NOTE: All of the following code is ONLY used for testing the [detectEngine]
#       procedure itself and can be safely removed.
#
###############################################################################

if {1} {
  #
  # NOTE: First, try the detection (possibly with TIP 440).
  #
  catch {
    puts "Detection (maybe) with TIP 440: [detectEngine]\n"
  }

  #
  # NOTE: Next, remove the TIP 440 array element.
  #
  catch {
    unset ::tcl_platform(engine)
  }

  #
  # NOTE: Next, remove the TIP 440 array element for Picol.
  #
  catch {
    #
    # NOTE: Picol cannot unset a single array element.  Use a
    #       workaround, just in case it is Picol.
    #
    if {[info exists tcl_platform(engine)]} {
      set list [array get tcl_platform]
      unset tcl_platform
      foreach {name value} $list {
        if {$name ne "engine"} {
          set tcl_platform($name) $value
        }
      }
    }
  }

  #
  # NOTE: Next, try the detection again without TIP 440.
  #
  catch {
    puts "Detection without TIP 440: [detectEngine]\n"
  }

  #
  # NOTE: Finally, halt evaluation of the script file.
  #
  catch {return ""}
}