Fossil

Check-in [663b722e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add support for the tcl_platform(platform) and tcl_platform(engine) array elements to TH1.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | tclPlatform
Files: files | file ages | folders
SHA1: 663b722e270738addc55ec37f6d7b9a0fa0faf8a
User & Date: mistachkin 2016-01-17 22:17:14.110
Context
2016-01-17
23:00
Minor naming tweak. ... (check-in: 07324777 user: mistachkin tags: tclPlatform)
22:17
Add support for the tcl_platform(platform) and tcl_platform(engine) array elements to TH1. ... (check-in: 663b722e user: mistachkin tags: tclPlatform)
22:12
Better runtime settings detection by the 'th1' test file. ... (check-in: d8d2222b user: mistachkin tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/th.c. 
1
2
3
4
5
6
7
8
9
10




















11
12
13
14
15
16
17


/*
** The implementation of the TH core. This file contains the parser, and
** the implementation of the interface in th.h.
*/

#include "config.h"
#include "th.h"
#include <string.h>
#include <assert.h>





















typedef struct Th_Command        Th_Command;
typedef struct Th_Frame          Th_Frame;
typedef struct Th_Variable       Th_Variable;
typedef struct Th_InterpAndList  Th_InterpAndList;

/*











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


/*
** The implementation of the TH core. This file contains the parser, and
** the implementation of the interface in th.h.
*/

#include "config.h"
#include "th.h"
#include <string.h>
#include <assert.h>

/*
** Values used for element values in the tcl_platform array.
*/

#if !defined(TH1_ENGINE)
#  define TH1_ENGINE         "TH1"
#endif

#if !defined(TH1_PLATFORM)
#  if defined(_WIN32) || defined(WIN32)
#    define TH1_PLATFORM     "windows"
#  else
#    define TH1_PLATFORM     "unix"
#  endif
#endif

/*
** Forward declarations for structures defined below.
*/

typedef struct Th_Command        Th_Command;
typedef struct Th_Frame          Th_Frame;
typedef struct Th_Variable       Th_Variable;
typedef struct Th_InterpAndList  Th_InterpAndList;

/*
︙︙
1754
1755
1756
1757
1758
1759
1760












1761
1762
1763
1764
1765
1766
1767


  Th_Free(interp, *pzStr);
  *pzStr = zNew;
  *pnStr = nNew;

  return TH_OK;
}













/*
** Delete an interpreter.
*/
void Th_DeleteInterp(Th_Interp *interp){
  assert(interp->pFrame);
  assert(0==interp->pFrame->pCaller);








>
>
>
>
>
>
>
>
>
>
>
>








1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799


  Th_Free(interp, *pzStr);
  *pzStr = zNew;
  *pnStr = nNew;

  return TH_OK;
}

/*
** Initialize an interpreter.
*/
static int thInitialize(Th_Interp *interp){
  assert(interp->pFrame);

  Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH1_ENGINE, -1);
  Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH1_PLATFORM, -1);

  return TH_OK;
}

/*
** Delete an interpreter.
*/
void Th_DeleteInterp(Th_Interp *interp){
  assert(interp->pFrame);
  assert(0==interp->pFrame->pCaller);
︙︙
1788
1789
1790
1791
1792
1793
1794

1795
1796
1797
1798
1799
1800
1801


  /* Allocate and initialise the interpreter and the global frame */
  p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
  memset(p, 0, sizeof(Th_Interp));
  p->pVtab = pVtab;
  p->paCmd = Th_HashNew(p);
  thPushFrame(p, (Th_Frame *)&p[1]);


  return p;
}

/*
** These two types are used only by the expression module, where
** the expression module means the Th_Expr() and exprXXX() functions.








>








1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834


  /* Allocate and initialise the interpreter and the global frame */
  p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
  memset(p, 0, sizeof(Th_Interp));
  p->pVtab = pVtab;
  p->paCmd = Th_HashNew(p);
  thPushFrame(p, (Th_Frame *)&p[1]);
  thInitialize(p);

  return p;
}

/*
** These two types are used only by the expression module, where
** the expression module means the Th_Expr() and exprXXX() functions.
︙︙
Changes to test/th1.test.
︙︙
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996


###############################################################################

fossil test-th-eval "info vars"

if {$th1Hooks} {
  test th1-info-vars-1 {$RESULT eq \
      "th_stack_trace cmd_flags cmd_name cmd_args"}
} else {
  test th1-info-vars-1 {$RESULT eq ""}
}

###############################################################################

fossil test-th-eval "set x 1; info vars"

if {$th1Hooks} {
  test th1-info-vars-2 {$RESULT eq \
      "x th_stack_trace cmd_flags cmd_name cmd_args"}
} else {
  test th1-info-vars-2 {$RESULT eq "x"}
}

###############################################################################

fossil test-th-eval "set x 1; unset x; info vars"

if {$th1Hooks} {
  test th1-info-vars-3 {$RESULT eq \
      "th_stack_trace cmd_flags cmd_name cmd_args"}
} else {
  test th1-info-vars-3 {$RESULT eq ""}
}

###############################################################################

fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"

if {$th1Hooks} {
  test th1-info-vars-5 {$RESULT eq \
      "th_stack_trace y cmd_flags cmd_name cmd_args"}
} else {
  test th1-info-vars-5 {$RESULT eq "y"}
}

###############################################################################

fossil test-th-eval "lsearch"
test th1-lsearch-1 {$RESULT eq \
    {TH_ERROR: wrong # args: should be "lsearch list string"}}








|

|








|

|








|

|













|

|








942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996


###############################################################################

fossil test-th-eval "info vars"

if {$th1Hooks} {
  test th1-info-vars-1 {$RESULT eq \
      "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-1 {$RESULT eq "tcl_platform"}
}

###############################################################################

fossil test-th-eval "set x 1; info vars"

if {$th1Hooks} {
  test th1-info-vars-2 {$RESULT eq \
      "x th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-2 {$RESULT eq "x tcl_platform"}
}

###############################################################################

fossil test-th-eval "set x 1; unset x; info vars"

if {$th1Hooks} {
  test th1-info-vars-3 {$RESULT eq \
      "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-3 {$RESULT eq "tcl_platform"}
}

###############################################################################

fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"

if {$th1Hooks} {
  test th1-info-vars-5 {$RESULT eq \
      "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-5 {$RESULT eq "y tcl_platform"}
}

###############################################################################

fossil test-th-eval "lsearch"
test th1-lsearch-1 {$RESULT eq \
    {TH_ERROR: wrong # args: should be "lsearch list string"}}
︙︙
1359
1360
1361
1362
1363
1364
1365











run_in_checkout {
  fossil test-th-eval --open-config \
      {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
}

test th1-encode64-3 {$RESULT eq \
"IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}


















>
>
>
>
>
>
>
>
>
>

1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375

run_in_checkout {
  fossil test-th-eval --open-config \
      {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
}

test th1-encode64-3 {$RESULT eq \
"IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}

###############################################################################

fossil test-th-eval {set tcl_platform(engine)}
test th1-platform-1 {$RESULT eq "TH1"}

###############################################################################

fossil test-th-eval {set tcl_platform(platform)}
test th1-platform-2 {$RESULT eq "windows" || $RESULT eq "unix"}