소스 검색

pas2js fixes: added compiler files

mattias 6 년 전
부모
커밋
fb8b744e39
100개의 변경된 파일47903개의 추가작업 그리고 0개의 파일을 삭제
  1. 2561 0
      compiler/packages/fcl-js/Makefile
  2. 102 0
      compiler/packages/fcl-js/Makefile.fpc
  3. 26 0
      compiler/packages/fcl-js/Makefile.fpc.fpcmake
  4. 23 0
      compiler/packages/fcl-js/README.TXT
  5. 21 0
      compiler/packages/fcl-js/examples/fpjsmin.pp
  6. 60 0
      compiler/packages/fcl-js/examples/srcmapdump.lpi
  7. 119 0
      compiler/packages/fcl-js/examples/srcmapdump.lpr
  8. 10 0
      compiler/packages/fcl-js/fcl-js-x86_64-linux.fpm
  9. 52 0
      compiler/packages/fcl-js/fpmake.pp
  10. 445 0
      compiler/packages/fcl-js/src/jsbase.pp
  11. 440 0
      compiler/packages/fcl-js/src/jsminifier.pp
  12. BIN
      compiler/packages/fcl-js/src/jsminifier.ppu
  13. 2147 0
      compiler/packages/fcl-js/src/jsparser.pp
  14. 903 0
      compiler/packages/fcl-js/src/jsscanner.pp
  15. 1252 0
      compiler/packages/fcl-js/src/jssrcmap.pas
  16. 93 0
      compiler/packages/fcl-js/src/jstoken.pp
  17. 1964 0
      compiler/packages/fcl-js/src/jstree.pp
  18. 2104 0
      compiler/packages/fcl-js/src/jswriter.pp
  19. 2576 0
      compiler/packages/fcl-js/tests/tcparser.pp
  20. 995 0
      compiler/packages/fcl-js/tests/tcscanner.pp
  21. 175 0
      compiler/packages/fcl-js/tests/tcsrcmap.pas
  22. 2732 0
      compiler/packages/fcl-js/tests/tcwriter.pp
  23. BIN
      compiler/packages/fcl-js/tests/testjs.ico
  24. 116 0
      compiler/packages/fcl-js/tests/testjs.lpi
  25. 26 0
      compiler/packages/fcl-js/tests/testjs.lpr
  26. 17 0
      compiler/packages/fcl-js/tests/testjs.manifest
  27. 1 0
      compiler/packages/fcl-js/tests/testjs.rc
  28. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jsbase.ppu
  29. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jsminifier.ppu
  30. 6 0
      compiler/packages/fcl-js/units/x86_64-linux/jsminifier.rsj
  31. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jsparser.ppu
  32. 26 0
      compiler/packages/fcl-js/units/x86_64-linux/jsparser.rsj
  33. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jsscanner.ppu
  34. 11 0
      compiler/packages/fcl-js/units/x86_64-linux/jsscanner.rsj
  35. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jssrcmap.ppu
  36. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jstoken.ppu
  37. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jstree.ppu
  38. BIN
      compiler/packages/fcl-js/units/x86_64-linux/jswriter.ppu
  39. 4 0
      compiler/packages/fcl-js/units/x86_64-linux/jswriter.rsj
  40. 2561 0
      compiler/packages/fcl-json/Makefile
  41. 102 0
      compiler/packages/fcl-json/Makefile.fpc
  42. 33 0
      compiler/packages/fcl-json/Makefile.fpc.fpcmake
  43. 46 0
      compiler/packages/fcl-json/examples/confdemo.lpi
  44. 101 0
      compiler/packages/fcl-json/examples/confdemo.pp
  45. 21 0
      compiler/packages/fcl-json/examples/demoformat.pp
  46. 362 0
      compiler/packages/fcl-json/examples/demortti.pp
  47. 22 0
      compiler/packages/fcl-json/examples/ini2json.pp
  48. 52 0
      compiler/packages/fcl-json/examples/j2y.pp
  49. 46 0
      compiler/packages/fcl-json/examples/parsedemo.lpi
  50. 137 0
      compiler/packages/fcl-json/examples/parsedemo.pp
  51. 46 0
      compiler/packages/fcl-json/examples/simpledemo.lpi
  52. 331 0
      compiler/packages/fcl-json/examples/simpledemo.pp
  53. 10 0
      compiler/packages/fcl-json/fcl-json-x86_64-linux.fpm
  54. 111 0
      compiler/packages/fcl-json/fpmake.pp
  55. 229 0
      compiler/packages/fcl-json/src/README.txt
  56. 3742 0
      compiler/packages/fcl-json/src/fpjson.pp
  57. 1178 0
      compiler/packages/fcl-json/src/fpjsonrtti.pp
  58. 1280 0
      compiler/packages/fcl-json/src/fpjsontopas.pp
  59. 171 0
      compiler/packages/fcl-json/src/json2yaml.pp
  60. 796 0
      compiler/packages/fcl-json/src/jsonconf.pp
  61. 548 0
      compiler/packages/fcl-json/src/jsonini.pp
  62. 241 0
      compiler/packages/fcl-json/src/jsonparser.pp
  63. 616 0
      compiler/packages/fcl-json/src/jsonreader.pp
  64. 538 0
      compiler/packages/fcl-json/src/jsonscanner.pp
  65. 360 0
      compiler/packages/fcl-json/tests/jsonconftest.pp
  66. 620 0
      compiler/packages/fcl-json/tests/tcjsonini.pp
  67. 2422 0
      compiler/packages/fcl-json/tests/tcjsontocode.pp
  68. 1007 0
      compiler/packages/fcl-json/tests/testcomps.pp
  69. 93 0
      compiler/packages/fcl-json/tests/testjson.lpi
  70. 41 0
      compiler/packages/fcl-json/tests/testjson.pp
  71. 70 0
      compiler/packages/fcl-json/tests/testjson2code.lpi
  72. 52 0
      compiler/packages/fcl-json/tests/testjson2code.lpr
  73. 66 0
      compiler/packages/fcl-json/tests/testjsonconf.lpi
  74. 28 0
      compiler/packages/fcl-json/tests/testjsonconf.pp
  75. 4098 0
      compiler/packages/fcl-json/tests/testjsondata.pp
  76. 633 0
      compiler/packages/fcl-json/tests/testjsonparser.pp
  77. 810 0
      compiler/packages/fcl-json/tests/testjsonreader.pp
  78. 1889 0
      compiler/packages/fcl-json/tests/testjsonrtti.pp
  79. BIN
      compiler/packages/fcl-json/units/x86_64-linux/fpjson.ppu
  80. 22 0
      compiler/packages/fcl-json/units/x86_64-linux/fpjson.rsj
  81. BIN
      compiler/packages/fcl-json/units/x86_64-linux/fpjsonrtti.ppu
  82. 15 0
      compiler/packages/fcl-json/units/x86_64-linux/fpjsonrtti.rsj
  83. BIN
      compiler/packages/fcl-json/units/x86_64-linux/fpjsontopas.ppu
  84. 5 0
      compiler/packages/fcl-json/units/x86_64-linux/fpjsontopas.rsj
  85. BIN
      compiler/packages/fcl-json/units/x86_64-linux/json2yaml.ppu
  86. BIN
      compiler/packages/fcl-json/units/x86_64-linux/jsonconf.ppu
  87. 5 0
      compiler/packages/fcl-json/units/x86_64-linux/jsonconf.rsj
  88. BIN
      compiler/packages/fcl-json/units/x86_64-linux/jsonini.ppu
  89. BIN
      compiler/packages/fcl-json/units/x86_64-linux/jsonparser.ppu
  90. 3 0
      compiler/packages/fcl-json/units/x86_64-linux/jsonparser.rsj
  91. BIN
      compiler/packages/fcl-json/units/x86_64-linux/jsonreader.ppu
  92. 9 0
      compiler/packages/fcl-json/units/x86_64-linux/jsonreader.rsj
  93. BIN
      compiler/packages/fcl-json/units/x86_64-linux/jsonscanner.ppu
  94. 5 0
      compiler/packages/fcl-json/units/x86_64-linux/jsonscanner.rsj
  95. 2561 0
      compiler/packages/fcl-passrc/Makefile
  96. 102 0
      compiler/packages/fcl-passrc/Makefile.fpc
  97. 24 0
      compiler/packages/fcl-passrc/Makefile.fpc.fpcmake
  98. 92 0
      compiler/packages/fcl-passrc/examples/parsepp.pp
  99. 62 0
      compiler/packages/fcl-passrc/examples/pasrewrite.lpi
  100. 482 0
      compiler/packages/fcl-passrc/examples/pasrewrite.pp

+ 2561 - 0
compiler/packages/fcl-js/Makefile

@@ -0,0 +1,2561 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+ifeq ($(OS_SOURCE),darwin)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=fcl-js
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+EXEDBGEXT=.dbg
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),wasm-wasm)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
+override FPCOPT+=-Cg
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 102 - 0
compiler/packages/fcl-js/Makefile.fpc

@@ -0,0 +1,102 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=fcl-js
+version=3.3.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources and omits the location of the source-
+# files from the fpunits.cfg files.
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 26 - 0
compiler/packages/fcl-js/Makefile.fpc.fpcmake

@@ -0,0 +1,26 @@
+#
+#   Makefile.fpc for Javascript Parser
+#
+
+[package]
+name=fcl-js
+version=3.3.1
+
+[target]
+units=jsbase jstree jsscanner jsparser
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[compiler]
+includedir=src
+sourcedir=src
+
+[shared]
+build=n
+
+[rules]
+.NOTPARALLEL:

+ 23 - 0
compiler/packages/fcl-js/README.TXT

@@ -0,0 +1,23 @@
+This is a package that contains a Javascript Scanner/parser/Syntax tree.
+
+The following units are defined:
+
+jsbase: the definition of Javascript values. Used to represent constant values.
+jstree: The Javascript syntax tree elements. Used in the parser to describe a source program
+jsscanner: the Javascript scanner. Currently not yet unicode-enabled.
+jsparser: the Javascript parser. Builds a complete javascript syntax tree.
+
+The tests directory contains a set of FPCUnit tests to test the scanner and parser.
+It needs Lazarus to run.
+
+Todo:
+- Add more tests.
+- Unicode support.
+- Runtime-engine ?
+
+The idea for the tree elements and the parser come from the Libsee library,
+written by David Leonard.
+
+Enjoy!
+
+Michael.

+ 21 - 0
compiler/packages/fcl-js/examples/fpjsmin.pp

@@ -0,0 +1,21 @@
+{$mode objfpc}{$h+}
+{$inline on}
+program fpjsmin;
+
+uses jsminifier;
+
+
+begin
+  if ParamCount<>2 then
+    begin
+    Writeln('Usage: fpjsmin infile outfile');
+    halt(1);
+    end;
+  With TJSONMinifier.Create(Nil) do
+    try
+       FileHeader.Add(paramstr(1));
+       Execute(ParamStr(1),ParamStr(2));
+    finally
+      Free
+    end;
+end.

+ 60 - 0
compiler/packages/fcl-js/examples/srcmapdump.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="SrcMapDump"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="srcmapdump.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="srcmapdump"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 119 - 0
compiler/packages/fcl-js/examples/srcmapdump.lpr

@@ -0,0 +1,119 @@
+program srcmapdump;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp, JSSrcMap;
+
+type
+
+  { TSrcMapDump }
+
+  TSrcMapDump = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+    procedure DumpSrcMap(SrcMapFile, aGeneratedFilename: string);
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TSrcMapDump }
+
+procedure TSrcMapDump.DoRun;
+var
+  ErrorMsg, SrcMapFilename, GeneratedFilename: String;
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hs:g:', 'help srcmap: generatedfile:');
+  if ErrorMsg<>'' then begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', 'help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+
+  if not HasOption('s','srcmap') then begin
+    writeln('missing -s >srcmap>');
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  SrcMapFilename:=ExpandFileName(GetOptionValue('s','srcmap'));
+
+  if not HasOption('g','generatedfile') then begin
+    writeln('missing -g <generatedfile>');
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  GeneratedFilename:=ExpandFileName(GetOptionValue('g','generatedfile'));
+
+  DumpSrcMap(SrcMapFilename,GeneratedFilename);
+
+  // stop program loop
+  Terminate;
+end;
+
+procedure TSrcMapDump.DumpSrcMap(SrcMapFile, aGeneratedFilename: string);
+var
+  SrcMap: TSourceMap;
+  GenSrc: TStringList;
+  i: Integer;
+  GenSrcLine, InfoLine: String;
+begin
+  GenSrc:=TStringList.Create;
+  SrcMap:=TSourceMap.Create(aGeneratedFilename);
+  try
+    SrcMap.LoadFromFile(SrcMapFile);
+    GenSrc.LoadFromFile(aGeneratedFilename);
+    for i:=1 to GenSrc.Count do begin
+      GenSrcLine:=GenSrc[i-1];
+      DebugSrcMapLine(i,GenSrcLine,SrcMap,InfoLine);
+      writeln(GenSrcLine);
+      writeln(InfoLine);
+    end;
+  finally
+    SrcMap.Free;
+    GenSrc.Free;
+  end;
+end;
+
+constructor TSrcMapDump.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TSrcMapDump.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSrcMapDump.WriteHelp;
+begin
+  writeln('Usage: ', ExeName, ' -h');
+  writeln;
+  writeln('-s <srcmap>');
+  writeln('-g <generatedfile>');
+end;
+
+var
+  Application: TSrcMapDump;
+begin
+  Application:=TSrcMapDump.Create(nil);
+  Application.Title:='SrcMapDump';
+  Application.Run;
+  Application.Free;
+end.
+

+ 10 - 0
compiler/packages/fcl-js/fcl-js-x86_64-linux.fpm

@@ -0,0 +1,10 @@
+Name=fcl-js
+Version=3.3.1
+Checksum=1549701252
+CPU=x86_64
+OS=linux
+SourcePath=/home/mattias/pascal/fpc_sources/3.3.1/fpc/packages/fcl-js/
+FPMakeOptions=-o -Ur -o -Xs -o -O2 -o -n -o -Cg -o -dx86_64 -o -dRELEASE -o -XX -o -CX
+Depends=rtl,fcl-base|1549701242,fcl-json|1549701248
+NeedLibC=N
+FPMakeAddIn=N

+ 52 - 0
compiler/packages/fcl-js/fpmake.pp

@@ -0,0 +1,52 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('fcl-js');
+    P.ShortName:='fcjs';
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.3.1';
+    P.Author := 'Michael Van Canneyt';
+    P.License := 'LGPL with FPC modification';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '[email protected]';
+    P.Description := 'Javascript scanner/parser/syntax tree units';
+    P.OSes:=AllOSes-[embedded,msdos,win16,macos,palmos];
+    if Defaults.CPU=jvm then
+      P.OSes := P.OSes - [java,android];
+
+    P.Dependencies.Add('fcl-base');
+    P.Dependencies.Add('fcl-json');
+
+    P.SourcePath.Add('src');
+    P.IncludePath.Add('src');
+
+    T:=P.Targets.AddUnit('jsbase.pp');
+    T:=P.Targets.AddUnit('jstoken.pp');
+    T:=P.Targets.AddUnit('jstree.pp');
+    T:=P.Targets.AddUnit('jssrcmap.pas');
+    T:=P.Targets.AddUnit('jsscanner.pp');
+      T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('jsparser.pp');
+      T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('jswriter.pp');
+      T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('jsminifier.pp');
+      T.ResourceStrings:=true;
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}

+ 445 - 0
compiler/packages/fcl-js/src/jsbase.pp

@@ -0,0 +1,445 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript base definitions
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+                                 
+unit jsbase;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  {$ifdef pas2js}
+  js,
+  {$endif}
+  Classes, SysUtils;
+
+const
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
+Type
+  TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
+
+  TJSString = UnicodeString;
+  TJSChar = WideChar;
+  TJSNumber = Double;
+  {$ifdef fpc}
+  TJSPChar = PWideChar;
+  {$endif}
+
+  { TJSValue }
+
+  TJSValue = Class(TObject)
+  private
+    FValueType: TJSType;
+    {$ifdef pas2js}
+    FValue: JSValue;
+    {$else}
+    FValue : Record
+      Case Integer of
+      0 : (P : Pointer);
+      1 : (F : TJSNumber);
+      2 : (I : Integer);
+    end;
+    {$endif}
+    FCustomValue: TJSString;
+    procedure ClearValue(ANewValue: TJSType);
+    function GetAsBoolean: Boolean;
+    function GetAsCompletion: TObject;
+    function GetAsNumber: TJSNumber;
+    function GetAsObject: TObject;
+    function GetAsReference: TObject;
+    function GetAsString: TJSString;
+    function GetIsNull: Boolean;
+    function GetIsUndefined: Boolean;
+    procedure SetAsBoolean(const AValue: Boolean);
+    procedure SetAsCompletion(const AValue: TObject);
+    procedure SetAsNumber(const AValue: TJSNumber);
+    procedure SetAsObject(const AValue: TObject);
+    procedure SetAsReference(const AValue: TObject);
+    procedure SetAsString(const AValue: TJSString);
+    procedure SetIsNull(const AValue: Boolean);
+    procedure SetIsUndefined(const AValue: Boolean);
+  Public
+    Constructor Create;
+    Constructor CreateNull;
+    Constructor Create(ANumber : TJSNumber);
+    Constructor Create(ABoolean : Boolean);
+    Constructor Create(AString: TJSString);
+    Destructor Destroy; override;
+    Property ValueType : TJSType Read FValueType;
+    Property CustomValue: TJSString Read FCustomValue Write FCustomValue;
+    Property IsUndefined : Boolean Read GetIsUndefined Write SetIsUndefined;
+    Property IsNull : Boolean Read GetIsNull Write SetIsNull;
+    Property AsNumber : TJSNumber Read GetAsNumber Write SetAsNumber;
+    Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
+    Property AsObject : TObject Read GetAsObject Write SetAsObject;
+    Property AsString : TJSString Read GetAsString Write SetAsString;
+    Property AsReference : TObject Read GetAsReference Write SetAsReference;
+    Property AsCompletion : TObject Read GetAsCompletion Write SetAsCompletion;
+  end;
+
+function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean = false): boolean;
+function StrToJSString(const S: String): TJSString; inline;
+function JSStringToString(const S: TJSString): String; inline;
+
+implementation
+
+function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean): boolean;
+{$ifdef pas2js}
+const
+  HexChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  p, l, i: Integer;
+begin
+  Result:=false;
+  if Name='' then exit;
+  l:=length(Name);
+  p:=1;
+  while p<=l do
+    case Name[p] of
+    '0'..'9':
+      if p=1 then
+        exit
+      else
+        inc(p);
+    'a'..'z','A'..'Z','_','$': inc(p);
+    '\':
+      begin
+      if not AllowEscapeSeq then exit;
+      inc(p);
+      if p>l then exit;
+      if Name[p]='x' then
+        begin
+        // \x00
+        inc(p);
+        if (p>l) or not (Name[p] in HexChars) then exit;
+        inc(p);
+        if (p>l) or not (Name[p] in HexChars) then exit;
+        end
+      else if Name[p]='u' then
+        begin
+        inc(p);
+        if p>l then exit;
+        if Name[p]='{' then
+          begin
+          // \u{00000}
+          i:=0;
+          repeat
+            inc(p);
+            if p>l then exit;
+            case Name[p] of
+            '}': break;
+            '0'..'9': i:=i*16+ord(Name[p])-ord('0');
+            'a'..'f': i:=i*16+ord(Name[p])-ord('a')+10;
+            'A'..'F': i:=i*16+ord(Name[p])-ord('A')+10;
+            else exit;
+            end;
+            if i>$FFFF then exit;
+          until false;
+          if (i>=$D800) and (i<$E000) then exit;
+          inc(p);
+          end
+        else
+          begin
+          // \u0000
+          for i:=1 to 4 do
+            begin
+            inc(p);
+            if (p>l) or not (Name[p] in HexChars) then exit;
+            end;
+          end;
+        // ToDo: check for invalid values like #$D800 and #$0041
+        end
+      else
+        exit; // unknown sequence
+      end;
+    #$200C,#$200D: inc(p); // zero width non-joiner/joiner
+    #$00AA..#$2000,
+    #$200E..#$D7FF:
+      inc(p); // ToDo: only those with ID_START/ID_CONTINUE see https://codepoints.net/search?IDC=1
+    #$D800..#$DFFF:
+      exit; // double code units are not allowed for JS identifiers
+    #$E000..#$FFFF:
+      inc(p);
+    else
+      exit;
+    end;
+  Result:=true;
+end;
+{$else}
+var
+  p: TJSPChar;
+  i: Integer;
+begin
+  Result:=false;
+  if Name='' then exit;
+  p:=TJSPChar(Name);
+  repeat
+    case p^ of
+    #0:
+      if p-TJSPChar(Name)=length(Name) then
+        exit(true)
+      else
+        exit;
+    '0'..'9':
+      if p=TJSPChar(Name) then
+        exit
+      else
+        inc(p);
+    'a'..'z','A'..'Z','_','$': inc(p);
+    '\':
+      begin
+      if not AllowEscapeSeq then exit;
+      inc(p);
+      if p^='x' then
+        begin
+        // \x00
+        for i:=1 to 2 do
+          begin
+          inc(p);
+          if not (p^ in ['0'..'9','a'..'f','A'..'F']) then exit;
+          end;
+        end
+      else if p^='u' then
+        begin
+        inc(p);
+        if p^='{' then
+          begin
+          // \u{00000}
+          i:=0;
+          repeat
+            inc(p);
+            case p^ of
+            '}': break;
+            '0'..'9': i:=i*16+ord(p^)-ord('0');
+            'a'..'f': i:=i*16+ord(p^)-ord('a')+10;
+            'A'..'F': i:=i*16+ord(p^)-ord('A')+10;
+            else exit;
+            end;
+            if i>$FFFF then exit;
+          until false;
+          if (i>=$D800) and (i<$E000) then exit;
+          inc(p);
+          end
+        else
+          begin
+          // \u0000
+          for i:=1 to 4 do
+            begin
+            inc(p);
+            if not (p^ in ['0'..'9','a'..'f','A'..'F']) then exit;
+            end;
+          end;
+        // ToDo: check for invalid values like #$D800 and #$0041
+        end
+      else
+        exit; // unknown sequence
+      end;
+    #$200C,#$200D: inc(p); // zero width non-joiner/joiner
+    #$00AA..#$2000,
+    #$200E..#$D7FF:
+      inc(p); // ToDo: only those with ID_START/ID_CONTINUE see https://codepoints.net/search?IDC=1
+    #$D800..#$DFFF:
+      exit; // double code units are not allowed for JS identifiers
+    #$E000..#$FFFF:
+      inc(p);
+    else
+      exit;
+    end;
+  until false;
+end;
+{$endif}
+
+function StrToJSString(const S: String): TJSString;
+begin
+  Result:={$ifdef pas2js}S{$else}UTF8Decode(S){$endif};
+end;
+
+function JSStringToString(const S: TJSString): String;
+begin
+  Result:={$ifdef pas2js}S{$else}UTF8Encode(S){$endif};
+end;
+
+{ TJSValue }
+
+function TJSValue.GetAsBoolean: Boolean;
+begin
+  If (ValueType=jstBoolean) then
+    Result:={$ifdef pas2js}boolean(FValue){$else}(FValue.I<>0){$endif}
+  else
+    Result:=False;
+end;
+
+function TJSValue.GetAsCompletion: TObject;
+begin
+  Result:=TObject(FValue{$ifdef fpc}.P{$endif});
+end;
+
+function TJSValue.GetAsNumber: TJSNumber;
+begin
+  If (ValueType=jstNumber) then
+    Result:={$ifdef pas2js}TJSNumber(FValue){$else}FValue.F{$endif}
+  else
+    Result:=0.0;
+end;
+
+function TJSValue.GetAsObject: TObject;
+begin
+  If (ValueType=jstObject) then
+    Result:=TObject(FValue{$ifdef fpc}.P{$endif})
+  else
+    Result:=nil;
+end;
+
+function TJSValue.GetAsReference: TObject;
+begin
+  If (ValueType=jstReference) then
+    Result:=TObject(FValue{$ifdef fpc}.P{$endif})
+  else
+    Result:=nil;
+end;
+
+function TJSValue.GetAsString: TJSString;
+begin
+  If (ValueType=jstString) then
+    Result:=TJSString(FValue{$ifdef fpc}.P{$endif})
+  else
+    Result:='';
+end;
+
+function TJSValue.GetIsNull: Boolean;
+begin
+  Result:=(ValueType=jstNull);
+end;
+
+function TJSValue.GetIsUndefined: Boolean;
+begin
+  Result:=(fValueType=jstUndefined);
+end;
+
+procedure TJSValue.ClearValue(ANewValue : TJSType);
+
+begin
+  {$ifdef pas2js}
+  Case FValueType of
+    jstUNDEFINED: FValue:=JS.Undefined;
+    jstString : FValue:='';
+    jstNumber : FValue:=0;
+    jstBoolean : FValue:=false;
+  else
+    FValue:=JS.Null;
+  end;
+  {$else}
+  Case FValueType of
+    jstString : String(FValue.P):='';
+    jstNumber : FValue.F:=0;
+  else
+    FValue.I:=0;
+  end;
+  {$endif}
+  FValueType:=ANewValue;
+  FCustomValue:='';
+end;
+
+procedure TJSValue.SetAsBoolean(const AValue: Boolean);
+begin
+  ClearValue(jstBoolean);
+  {$ifdef pas2js}
+  FValue:=AValue;
+  {$else}
+  FValue.I:=Ord(AValue);
+  {$endif}
+end;
+
+procedure TJSValue.SetAsCompletion(const AValue: TObject);
+begin
+  ClearValue(jstBoolean);
+  FValue{$ifdef fpc}.P{$endif}:=AValue;
+end;
+
+procedure TJSValue.SetAsNumber(const AValue: TJSNumber);
+begin
+  ClearValue(jstNumber);
+  FValue{$ifdef fpc}.F{$endif}:=AValue;
+end;
+
+procedure TJSValue.SetAsObject(const AValue: TObject);
+begin
+  ClearValue(jstObject);
+  FValue{$ifdef fpc}.P{$endif}:=AVAlue;
+end;
+
+procedure TJSValue.SetAsReference(const AValue: TObject);
+begin
+  ClearValue(jstReference);
+  FValue{$ifdef fpc}.P{$endif}:=AVAlue;
+end;
+
+procedure TJSValue.SetAsString(const AValue: TJSString);
+begin
+  ClearValue(jstString);
+  {$ifdef pas2js}FValue{$else}TJSString(FValue.P){$endif}:=AValue;
+end;
+
+procedure TJSValue.SetIsNull(const AValue: Boolean);
+begin
+  if AValue then
+    ClearValue(jstNull)
+  else if IsNull then
+    ClearValue(jstUNDEFINED);
+end;
+
+procedure TJSValue.SetIsUndefined(const AValue: Boolean);
+begin
+  if AValue then
+    ClearValue(jstUndefined)
+  else if IsUndefined then
+    ClearValue(jstNull);
+end;
+
+constructor TJSValue.CreateNull;
+begin
+  IsNull:=True;
+end;
+
+constructor TJSValue.Create;
+begin
+  IsUndefined:=True;
+end;
+
+constructor TJSValue.Create(ANumber: TJSNumber);
+begin
+  AsNumber:=ANumber;
+end;
+
+constructor TJSValue.Create(ABoolean: Boolean);
+begin
+  AsBoolean:=ABoolean;
+end;
+
+constructor TJSValue.Create(AString: TJSString);
+begin
+  AsString:=AString;
+end;
+
+destructor TJSValue.Destroy;
+begin
+  ClearValue(jstUndefined);
+  inherited Destroy;
+end;
+
+
+end.
+

+ 440 - 0
compiler/packages/fcl-js/src/jsminifier.pp

@@ -0,0 +1,440 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+{ ---------------------------------------------------------------------
+  Javascript minifier, based on an implementation by Douglas Crockford,
+  see original copyright.
+  ---------------------------------------------------------------------}
+{ jsmin.c
+   2013-03-29
+
+Copyright (c) 2002 Douglas Crockford  (www.crockford.com)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+The Software shall be used for Good, not Evil.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+}
+
+unit jsminifier;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses sysutils,classes,bufstream;
+
+
+Const
+  EOS = #0;
+
+Type
+
+  { TJSONMinifier }
+  EJSONMinifier = Class(Exception);
+
+  TJSONMinifier = Class(TComponent)
+  Private
+    FA : char;
+    FB : char;
+    FFileHeader: TStrings;
+    FLookahead : char;
+    FX : char;
+    FY : char ;
+    Fin : TStream;
+    Fout : TStream;
+    procedure SetFileHeader(AValue: TStrings);
+  Protected
+    // Token reading routines
+    function Peek : char;
+    function Get : char;inline;
+    function Next : char;
+    // Token writing routines
+    procedure Putc(c: char);inline;
+    Procedure Reset;
+    procedure DoHeader; virtual;
+    procedure Error(Const Msg: string);
+    Class Function isAlphaNum(c: char): boolean;
+    Class Function iif(B : Boolean; Const ifTrue,ifFalse : integer) : integer; inline;
+    procedure Action(d: Byte);
+    procedure Minify;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute(Const SourceFilename,DestFilename : String);
+    Procedure Execute(Source,Dest : TStream);
+    Procedure Execute(SourceFilenames : TStrings; Const DestFilename : String);
+    Procedure Execute(SourceFileNames : Array of string; Const DestFilename : String);
+  Published
+    Property FileHeader : TStrings Read FFileHeader Write SetFileHeader;
+  end;
+
+Implementation
+
+Resourcestring
+  SErrUnterminatedComment = 'Unterminated comment.';
+  SErrUnterminatedStringLiteral = 'Unterminated string literal.';
+  SErrUnterminatedSetInRegexp = 'Unterminated set in Regular Expression literal.';
+  SerrUnterminatedRegexp = 'Unterminated Regular Expression literal.';
+
+class function TJSONMinifier.iif(B: Boolean; const ifTrue, ifFalse: integer
+  ): integer;
+
+begin
+  if B then
+    Result:=ifTrue
+  else
+    Result:=ifFalse;
+end;
+
+procedure TJSONMinifier.Error(const Msg: string);
+
+begin
+  Raise EJSONMinifier.Create('JSMIN Error: '+Msg);
+end;
+
+procedure TJSONMinifier.SetFileHeader(AValue: TStrings);
+begin
+  if FFileHeader=AValue then Exit;
+  FFileHeader.Assign(AValue);
+end;
+
+procedure TJSONMinifier.Reset;
+
+begin
+  FA:=EOS;
+  FB:=EOS;
+  FLookahead:=EOS;
+  FX:=EOS;
+  FY:=EOS;
+end;
+
+class function TJSONMinifier.isAlphaNum(c: char): boolean;
+
+begin
+  Result:= (C in ['a'..'z']) or (c in ['0'..'9']) or (c in ['A'..'Z']) or (C in ['_','$','\']) or (c > #126);
+end;
+
+
+function TJSONMinifier.Get: char;
+
+begin
+  Result:=FLookahead;
+  FLookahead:=EOS;
+  if (Result=EOS) then
+    if Fin.Read(Result,sizeof(Result))=0 then exit;
+  if (Result>' ') or (Result in [#10,EOS]) then
+    Exit;
+  if (Result=#13) then
+    Result:=#10
+  else
+    Result:=' ';
+end;
+
+
+function TJSONMinifier.Peek: char;
+begin
+  FLookahead := get();
+  result:=FLookahead;
+end;
+
+function TJSONMinifier.Next: char;
+
+var
+ c : char;
+
+begin
+  c:= get();
+  if (c='/') then
+    case peek of
+      '/': Repeat
+             c := get();
+           until (c <= #10);
+      '*':
+           begin
+           Get();
+           while (c <> ' ') do
+             case get of
+               '*':
+                 begin
+                 if (peek()= '/') then
+                   begin
+                   get();
+                   c:=' ';
+                   end;
+                 end;
+               EOS:
+                 Error(SErrUnterminatedComment);
+              end;
+           end;
+    end;
+  FY:=FX;
+  FX:=c;
+  Result:=c;
+end;
+
+procedure TJSONMinifier.Putc(c: char);
+
+begin
+  Fout.writebuffer(c,sizeof(c));
+end;
+
+procedure TJSONMinifier.Action(d : Byte);
+
+  Procedure Do1;
+
+  begin
+    putc(FA);
+    if ((FY in [#10,' '])
+        and (FA in ['+','-','*','/'])
+        and (FB in ['+','-','*','/'])) then
+      putc(FY);
+  end;
+
+  Procedure Do2;
+
+  begin
+    FA:=FB;
+    if (FA in ['''','"','`']) then
+      While true do
+        begin
+        putc(FA);
+        FA:= get();
+        if (FA=FB) then
+          break;
+        if (FA='\') then
+          begin
+          putc(FA);
+          FA:=get();
+          end;
+        if (FA=EOS) then
+          Error(SErrUnterminatedStringLiteral);
+        end;
+  end;
+
+begin
+  if (D=1) then
+    Do1;
+  if (D in [1,2]) then
+    Do2;
+  FB := next();
+  if (FB='/') and (FA in ['(',',','=',':','[','!','&','|','?','+','-','~','*','/','{',#10]) then
+    begin
+    putc(FA);
+    if (FA in ['/','*']) then
+       putc(' ');
+    putc(FB);
+    While true do
+      begin
+      FA := get();
+      if (FA='[') then
+        begin
+        While true do
+          begin
+          putc(FA);
+          FA := get();
+          if (FA = ']') then
+            break;
+          if (FA = '\') then
+            begin
+            putc(FA);
+            FA := get();
+            end;
+          if (FA = EOS) then
+            Error(SErrUnterminatedSetInRegexp);
+          end
+        end
+      else if (FA = '/') then
+        begin
+        case (peek()) of
+           '/', '*':
+            Error(SErrUnterminatedSetInRegexp);
+        end;
+        Break;
+        end
+      else if (FA ='\') then
+        begin
+        putc(FA);
+        FA := get();
+        end;
+      if (FA = EOS) then
+        Error(SErrUnterminatedRegexp);
+      putc(FA);
+      end;
+    FB := next();
+    end;
+end;
+
+
+procedure TJSONMinifier.Minify;
+
+begin
+  if (peek()= #$EF) then
+    begin
+    get();
+    get();
+    get();
+    end;
+  FA:=#10;
+  action(3);
+  while (FA <> EOS) do
+    begin
+    case (FA) of
+      ' ':
+        action(iif(isAlphanum(FB),1,2));
+      #10:
+        case (FB) of
+          '{', '[', '(', '+', '-', '!', '~':
+            Action(1);
+          ' ':
+                Action(3);
+        else
+          Action(iif(isAlphanum(FB), 1 , 2));
+        end;
+    else
+      case (FB) of
+        ' ':
+          Action(iif(isAlphanum(FA),1,3));
+        #10:
+          case (FA) of
+            '}',']',')','+','-','"', '''', '`':
+              Action(1);
+          else
+            Action(iif(isAlphanum(FA), 1, 3));
+         end;
+      else
+        Action(1);
+      end;
+    end;
+    end;
+end;
+
+constructor TJSONMinifier.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFileHeader:=TStringList.Create;
+end;
+
+destructor TJSONMinifier.Destroy;
+begin
+  FreeAndNil(FFileHeader);
+  inherited Destroy;
+end;
+
+procedure TJSONMinifier.Execute(const SourceFilename, DestFilename: String);
+
+Var
+ Src,Dest : TBufStream;
+
+begin
+ Dest:=Nil;
+ Src:=TReadBufStream.Create(TFileStream.Create(SourceFileName,fmOpenRead or fmShareDenyWrite),1000);
+ try
+   Src.SourceOwner:=True;
+   Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+   Dest.SourceOwner:=True;
+   Execute(Src,Dest);
+ finally
+   Src.Free;
+   Dest.Free;
+ end;
+end;
+
+procedure TJSONMinifier.DoHeader;
+
+Var
+  S,L : String;
+
+begin
+  For S in FFileHeader do
+    begin
+    L:='// '+S+sLineBreak;
+    Fout.WriteBuffer(L[1],Length(L));
+    end;
+end;
+
+procedure TJSONMinifier.Execute(Source, Dest: TStream);
+
+begin
+  Fin:=Source;
+  Fout:=Dest;
+  try
+    Reset;
+    DoHeader;
+    Minify;
+  finally
+    Fin:=Nil;
+    Fout:=Nil;
+  end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFilenames: TStrings;const DestFilename: String);
+
+Var
+  Src,Dest : TBufStream;
+  I : Integer;
+
+begin
+ Dest:=Src;
+ Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+ try
+   Dest.SourceOwner:=True;
+   for I:=0 to SourceFileNames.Count-1 do
+     begin
+     Src:=TReadBufStream.Create(TFileStream.Create(SourceFileNames[i],fmOpenRead or fmShareDenyWrite),1000);
+     Src.SourceOwner:=True;
+     Execute(Src,Dest);
+     FreeAndNil(Src);
+     end;
+ finally
+   FreeAndNil(Src);
+   FreeAndNil(Dest);
+ end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFileNames: array of string;
+  const DestFilename: String);
+
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  try
+    S.AddStrings(SourceFileNames);
+    Execute(S,DestFileName);
+  finally
+    S.Free;
+  end;
+end;
+
+
+end.
+

BIN
compiler/packages/fcl-js/src/jsminifier.ppu


+ 2147 - 0
compiler/packages/fcl-js/src/jsparser.pp

@@ -0,0 +1,2147 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript parser
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+unit jsparser;
+
+{ $define debugparser}
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, jsscanner, jstree, jstoken;
+
+Const
+   SEmptyLabel = '';
+
+Type
+
+  { TJSParser }
+
+  TJSParser = Class(TObject)
+  Private
+    FFunctionDepth: Integer;
+    FInput : TStream;
+    FIsLHS: Boolean;
+    FNoIn: Boolean;
+    FScanner : TJSScanner;
+    FPrevious,
+    FCurrent : TJSToken;
+    FCurrentString : String;
+    FFreeScanner : Boolean;
+    FCurrentVars : TJSElementNodes;
+    FPeekToken: TJSToken;
+    FPeekTokenString: String;
+    FLabelSets,
+    FCurrentLabelSet:TJSLabelSet;
+    FLabels : TJSLabel;
+    function CheckSemiColonInsert(aToken: TJSToken; Consume: Boolean): Boolean;
+    function EnterLabel(ALabelName: String): TJSLabel;
+    procedure Expect(aToken: TJSToken);
+    procedure Consume(aToken: TJSToken; AllowSemicolonInsert : Boolean = False);
+    procedure FreeCurrentLabelSet;
+    procedure LeaveLabel;
+    function LookupLabel(ALabelName: String; Kind: TJSToken): TJSLabel;
+    function ParseAdditiveExpression: TJSElement;
+    function ParseArguments: TJSarguments;
+    function ParseArrayLiteral: TJSElement;
+    function ParseAssignmentExpression: TJSElement;
+    function ParseBitwiseAndExpression: TJSElement;
+    function ParseBitwiseORExpression: TJSElement;
+    function ParseBitwiseXORExpression: TJSElement;
+    function ParseBlock: TJSElement;
+    function ParseBreakStatement: TJSElement;
+    function ParseConditionalExpression: TJSElement;
+    function ParseContinueStatement: TJSElement;
+    function ParseEmptyStatement: TJSElement;
+    function ParseEqualityExpression: TJSElement;
+    function ParseExpression: TJSElement;
+    function ParseExpressionStatement: TJSElement;
+    function ParseFormalParameterList: TStrings;
+    function ParseFunctionDeclaration: TJSFunctionDeclarationStatement;
+    function ParseFunctionExpression: TJSFunctionDeclarationStatement;
+    function ParseFunctionStatement: TJSElement;
+    function ParseFunctionBody: TJSFunctionBody;
+    function ParseIdentifier: String;
+    function ParseIfStatement: TJSElement;
+    function ParseIterationStatement: TJSElement;
+    function ParseLabeledStatement: TJSElement;
+    function ParseLeftHandSideExpression: TJSElement;
+    function ParseLiteral: TJSElement;
+    function ParseLogicalAndExpression: TJSElement;
+    function ParseLogicalORExpression: TJSElement;
+    function ParseMemberExpression: TJSElement;
+    function ParseMultiplicativeExpression: TJSElement;
+    function ParseNumericLiteral: TJSElement;
+    function ParseObjectLiteral: TJSElement;
+    function ParsePostFixExpression: TJSElement;
+    function ParsePrimaryExpression: TJSElement;
+    function ParseRegularExpressionLiteral: TJSElement;
+    function ParseRelationalExpression: TJSElement;
+    function ParseReturnStatement: TJSElement;
+    function ParseShiftExpression: TJSElement;
+    function ParseStatement: TJSElement;
+    function ParseStatementList: TJSElement;
+    function ParseStringLiteral: TJSElement;
+    function ParseSwitchStatement: TJSElement;
+    function ParseThrowStatement: TJSElement;
+    function ParseTryStatement: TJSElement;
+    function ParseUnaryExpression: TJSElement;
+    function ParseVariableDeclaration: TJSElement;
+    function ParseVariableDeclarationList: TJSElement;
+    function ParseVariableStatement: TJSElement;
+    function ParseWithStatement: TJSElement;
+  Protected
+    Procedure CheckParser;
+    Function CurrentLabelSet : TJSLabelSet;
+    function CurSource: String;
+    Function CurLine : Integer;
+    Function CurPos : Integer;
+    Function CreateElement(AElementClass : TJSElementClass)  : TJSElement;
+    Procedure Error(Msg : String);
+    Procedure Error(Fmt : String; Args : Array of const);
+    // Parse functions
+    function ParseSourceElements: TJSSourceElements;
+    Property FunctionDepth : Integer Read FFunctionDepth Write FFunctionDepth;
+    Property NoIn : Boolean Read FNoIn Write FNoIn;
+    Property IsLHS : Boolean Read FIsLHS Write FIsLHS;
+  Public
+    Constructor Create(AInput: TStream);
+    Constructor Create(AScanner : TJSScanner);
+    Destructor Destroy; override;
+    Function Parse : TJSElement;
+    Function ParseProgram : TJSFunctionDeclarationStatement;
+    Function CurrentToken : TJSToken;
+    Function CurrentTokenString : String;
+    Function GetNextToken : TJSToken;
+    Function PeekNextToken : TJSToken;
+    Function IsEndOfLine : Boolean;
+  end;
+
+implementation
+
+uses typinfo;
+
+Resourcestring
+  SErrUnmatchedCurlyBrace    = 'Unmatched }';
+  SErrUnmatchedSquareBrace   = 'Unmatched ]';
+  SErrUnmatchedBrace         = 'Unmatched )';
+  SErrUnexpectedToken        = 'Unexpected token: ''%s''';
+  SErrTokenMismatch          = 'Unexpected token: ''%s'', expected: ''%s''';
+  SErrSemicolonOrInExpected  = 'Unexpected token: ''%s'', expected ; or ''in''';
+  SErrSemicolonExpected      = 'Unexpected token: ''%s'', expected ;';
+  SErrDuplicateLabelName     = 'Duplicate label name: ''%s''';
+  SErrLabelNotContinuable    = 'Label ''%s'' is not suitable for continue.';
+  SErrLabelNOtDefinedOrReachable = 'Label ''%s'' is not defined or not reachable.';
+  SErrContinueNotInLoop      = 'Continue statement not in loop';
+  SErrBreakNotInLoop         = 'Break statement not in loop';
+  SErrReturnNotInFunction    = 'return statement not in a function body';
+  SErrCaseEndExpected        = 'Unexpected token: Expected }, case or default clause';
+  SErrDuplicateSwitchDefault = 'Duplicate default clause for switch statement';
+  SErrNewlineAfterThrow      = 'Newline after throw not allowed';
+  SErrCatchFinallyExpected   = 'Unexpected token: Expected ''catch'' or ''finally''';
+  SErrArgumentsExpected      = 'Unexpected token: Expected '','' or '')'', got %s';
+  SErrArrayEnd               = 'Unexpected token: Expected '','' or '']'', got %s';
+  //SErrObjectEnd              = 'Unexpected token: Expected '','' or ''}'', got %s';
+  SErrObjectElement          = 'Unexpected token: Expected string, identifier or number after '','' got: %s';
+  SErrLiteralExpected        = 'Unexpected token: Expected: null, true, false, number, string, or regex, got: %s';
+  SErrInvalidnumber          = 'Invalid numerical value: %s';
+  SErrInvalidRegularExpression = 'Invalid regular expression: %s';
+  SErrFunctionNotAllowedHere = 'function keyword not allowed here';
+
+{ TJSScanner }
+
+Function TJSParser.CurrentToken: TJSToken;
+
+begin
+  Result:=FCurrent;
+end;
+
+Function TJSParser.CurrentTokenString: String;
+begin
+  Result:=FCurrentString;
+end;
+
+Function TJSParser.GetNextToken: TJSToken;
+begin
+  FPrevious:=FCurrent;
+  If (FPeekToken<>tjsunknown) then
+     begin
+     FCurrent:=FPeekToken;
+     FCurrentString:=FPeekTokenString;
+     FPeekToken:=tjsUnknown;
+     FPeekTokenString:='';
+     end
+  else
+    begin
+    FCurrent:=FScanner.FetchToken;
+    FCurrentString:=FScanner.CurTokenString;
+    end;
+  Result:=FCurrent;
+  {$ifdef debugparser}Writeln('GetNextToken (',FScanner.CurLine,',',FScanner.CurColumn,'): ',GetEnumName(TypeInfo(TJSToken),Ord(FCurrent)), ' As string: ',FCurrentString);{$endif debugparser}
+end;
+
+Function TJSParser.PeekNextToken: TJSToken;
+begin
+  If (FPeekToken=tjsUnknown) then
+    begin
+    FPeekToken:=FScanner.FetchToken;
+    FPeekTokenString:=FScanner.CurTokenString;
+    end;
+  {$ifdef debugparser}Writeln('PeekNextToken : ',GetEnumName(TypeInfo(TJSToken),Ord(FPeekToken)), ' As string: ',FPeekTokenString);{$endif debugparser}
+  Result:=FPeekToken;
+end;
+
+Function TJSParser.IsEndOfLine: Boolean;
+begin
+  Result:=FScanner.IsEndOfLine;
+end;
+
+
+Function TJSParser.CurPos: Integer;
+begin
+  If Assigned(FScanner) then
+    Result:=FScanner.CurColumn
+  else
+    Result:=0;
+end;
+
+Function TJSParser.CurLine: Integer;
+begin
+  If Assigned(FScanner) then
+    Result:=FScanner.CurRow
+  else
+    Result:=0;
+end;
+
+function TJSParser.CurSource: String;
+begin
+  If Assigned(FScanner) then
+    Result:=FScanner.CurFileName
+  else
+    Result:='';
+end;
+
+Procedure TJSParser.CheckParser;
+begin
+
+end;
+
+procedure TJSParser.LeaveLabel;
+
+Var
+  L : TJSLabel;
+
+begin
+  L:=FLabels;
+  FLabels:=FLabels.Next;
+  L.Free; // ??
+end;
+
+function TJSParser.LookupLabel(ALabelName : String; Kind : TJSToken) :TJSLabel;
+
+Var
+  L : TJSLabel;
+
+begin
+  L:=FLabels;
+  Result:=Nil;
+  While (L<>Nil) and (Result=Nil) do
+    begin
+    If (L.Name=ALabelName) then
+      begin
+      if (kind=tjsContinue) and (Not L.LabelSet.Continuable) and (ALabelName<>SEmptyLabel) then
+        Error(SErrLabelNotContinuable,[ALabelName]);
+      Result:=L;
+      end;
+    L:=L.Next;
+    end;
+  If (Result=Nil) then
+    begin
+    If (ALabelName<>'') then
+      Error(SErrLabelNOtDefinedOrReachable,[ALabelName])
+    else if kind=tjsCOntinue then
+      Error(SErrContinueNotInLoop)
+    else
+      Error(SErrBreakNotInLoop);
+    end;
+end;
+
+function TJSParser.EnterLabel(ALabelName : String) :TJSLabel;
+
+Var
+  L : TJSLabel;
+
+begin
+  If (ALAbelName<>SEmptyLabel) then
+    begin
+    L:=FLabels;
+    While (L<>Nil) do
+      begin
+      If (L.Name=ALabelName) then
+        Error(SErrDuplicateLabelName,[ALabelName]);
+      L:=L.Next;
+      end;
+    end;
+  L:=TJSLabel.Create;
+  L.Name:=ALabelName;
+  L.LabelSet:=CurrentLabelSet;
+  L.LocationSource:=Self.CurSource;
+  L.LocationLine:=CurLine;
+  L.LocationPos:=CurPos;
+  L.Next:=FLabels;
+  FLabels:=L;
+  Result:=L;
+end;
+
+Function TJSParser.CurrentLabelSet: TJSLabelSet;
+
+Var
+  LS : TJSLabelSet;
+
+begin
+  If (FCurrentLabelSet=Nil) then
+    begin
+    LS:=TJSLabelSet.Create;
+    If (FLabelSets=Nil) then
+      LS.Target:=1
+    else
+      LS.Target:=FLabelSets.Target;
+    LS.Next:=FLabelSets;
+    FLabelSets:=LS;
+    FCurrentLabelSet:=LS;
+    end;
+  Result:=FCurrentLabelSet;
+end;
+
+Function TJSParser.CreateElement(AElementClass: TJSElementClass): TJSElement;
+begin
+  Result:=AElementClass.Create(CurLine,CurPos,CurSource);
+end;
+
+Procedure TJSParser.Error(Msg: String);
+
+Var
+  ErrAt : String;
+
+begin
+  If Assigned(FScanner) then
+    If FScanner.CurFilename<>'' then
+      ErrAt:=Format('Error: file "%s" line %d, pos %d: ',[FScanner.CurFileName,FScanner.CurRow,FScanner.CurColumn])
+    else
+      ErrAt:=Format('Error: line %d, pos %d: ',[FScanner.Currow,FScanner.CurColumn]);
+  Raise Exception.Create(ErrAt+Msg)
+end;
+
+Procedure TJSParser.Error(Fmt: String; Args: Array of const);
+begin
+  Error(Format(Fmt,Args));
+end;
+
+Constructor TJSParser.Create(AInput: TStream);
+begin
+  FInput:=AInput;
+  FCurrent:=TJSUnknown;
+  FScanner:=TJSScanner.Create(FInput);
+  FFreeScanner:=True;
+end;
+
+Constructor TJSParser.Create(AScanner: TJSScanner);
+begin
+  FCurrent:=TJSUnknown;
+  FScanner:=AScanner;
+  FFreeScanner:=False;
+end;
+
+Destructor TJSParser.Destroy;
+begin
+  if FFreeScanner then
+    FreeAndNil(FScanner);
+  inherited;
+end;
+
+
+
+procedure TJSParser.Expect(aToken: TJSToken);
+
+begin
+  {$ifdef debugparser}  Writeln('Expecting : ',GetEnumName(TypeInfo(TJSToken),Ord(AToken)), ' As string: ',TokenInfos[AToken]);{$endif debugparser}
+  If Not CheckSemiColonInsert(AToken,False) then
+    if (CurrentToken<>aToken) then
+      Error(SerrTokenMismatch,[CurrenttokenString,TokenInfos[aToken]]);
+end;
+
+function TJSParser.CheckSemiColonInsert(aToken : TJSToken; Consume : Boolean) : Boolean;
+
+begin
+  Result:=(AToken=tjsSemiColon);
+  If Result then
+    begin
+    Result:=(CurrentToken=tjsCurlyBraceClose) or (FScanner.WasEndOfLine) or (CurrentToken=tjsEOF);
+    If Result and Consume then
+      FPrevious:=tjsSemiColon;
+    end;
+end;
+
+procedure TJSParser.Consume(aToken: TJSToken; AllowSemicolonInsert: Boolean);
+begin
+  {$ifdef debugparser}  Writeln('Consuming : ',GetEnumName(TypeInfo(TJSToken),Ord(AToken)), ' As string: ',TokenInfos[AToken]);{$endif debugparser}
+  Expect(aToken);
+  If not (AllowSemiColonInsert and CheckSemiColonInsert(aToken,True)) then
+    GetNextToken;
+end;
+
+function TJSParser.ParseIdentifier : String;
+
+begin
+  Result:='';
+  Repeat
+    Expect(tjsIdentifier);
+    Result:=Result+CurrentTokenString;
+    GetNextToken;
+    If (CurrentToken=tjsDot) then
+      begin
+      If (Result<>'') then
+         Result:=Result+'.';
+      GetNextToken;
+      end;
+  until (CurrentToken<>tjsIdentifier);
+end;
+
+function TJSParser.ParseFormalParameterList : TStrings;
+
+begin
+  Result:=Nil;
+  While (CurrentToken=tjsIdentifier) do
+    begin
+    Expect(tjsIdentifier);
+    If (Result=Nil) then
+      Result:=TstringList.Create;
+    Result.Add(CurrentTokenString);
+    GetNextToken;
+    If (CurrentToken=tjsComma) then
+       GetNextToken;
+    end;
+end;
+
+
+function TJSParser.ParseFunctionDeclaration : TJSFunctionDeclarationStatement;
+
+Var
+  Id : String;
+  D : TJSFuncDef;
+  args : TStrings;
+  body : TJSFunctionBody;
+
+begin
+  {$ifdef debugparser}  Writeln('>>> Entering ParseFunctionDeclaration');{$endif debugparser}
+  Consume(tjsFunction);
+  ID:=ParseIdentifier;
+  Consume(tjsBraceOpen);
+  Args:=ParseFormalParameterList;
+  try
+    Consume(tjsBraceClose);
+    Consume(tjsCurlyBraceOpen);
+    Inc(FFunctionDepth);
+    try
+      Body:=ParseFunctionBody;
+      try
+        // GetNextToken; not sure
+        Consume(tjsCurlyBraceClose);
+        D:=TJSFuncDef.Create;
+        try
+          D.Name:=ID;
+          If Assigned(Args)then
+            D.Params.Assign(Args);
+          D.Body:=Body;
+          Result:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement));
+          Result.AFunction:=D;
+        except
+          FreeAndNil(D);
+          Raise;
+        end;
+      except
+        FreeAndNil(Body);
+        Raise;
+      end;
+    finally
+      Dec(FFunctionDepth);
+    end;
+  finally
+    FreeAndNil(Args);
+  end;
+  {$ifdef debugparser}  Writeln('>>> Exiting ParseFunctionDeclaration');{$endif debugparser}
+end;
+
+function TJSParser.ParseStatementList : TJSElement;
+
+Var
+  E : TJSElement;
+  SL : TJSSTatementList;
+
+begin
+  {$ifdef debugparser}  Writeln('>>> ParseStatementList');{$endif debugparser}
+  E:=ParseStatement;
+  try
+    if (CurrentToken in [tjsCurlyBraceClose,tjsEof,tjsCase,tjsDefault]) then
+      Result:=E
+    else
+      begin
+      SL:=TJSSTatementList(CreateElement(TJSStatementList));
+      try
+        SL.A:=E;
+        SL.B:=ParseStatementlist();
+        Result:=SL;
+      except
+        FreeAndNil(SL);
+        Raise;
+      end;
+      end;
+  except
+    FreeAndNil(E);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('<<< ParseStatementList');{$endif debugparser}
+end;
+
+function TJSParser.ParseBlock : TJSElement;
+
+begin
+  {$ifdef debugparser}  Writeln('>>> ParseBlock');{$endif debugparser}
+  Consume(tjsCurlyBraceOpen);
+  If (CurrentToken=tjsCurlyBraceClose) then
+    Result:=CreateElement(TJSEmptyBlockStatement)
+  else
+    result:=ParseStatementList;
+  Consume(tjsCurlyBraceClose);
+  {$ifdef debugparser}  Writeln('<<< ParseBlock');{$endif debugparser}
+end;
+
+function TJSParser.ParseArrayLiteral: TJSElement;
+
+Var
+  N : TJSArrayLiteral;
+  E : TJSArrayLiteralElement;
+  I : Integer;
+
+begin
+  Consume(tjsSquaredBraceOpen);
+  N:=TJSArrayLiteral(CreateElement(TJSArrayLiteral));
+  Result:=N;
+  try
+    I:=0;
+    While (CurrentToken<>tjsSquaredBraceClose) do
+      begin
+      If (CurrentToken=tjsComma) then
+         begin
+         GetNextToken;
+         Inc(I);
+         end
+      else
+         begin
+         E:=N.Elements.AddElement;
+         E.ElementIndex:=I;
+         Inc(I);
+         E.Expr:=ParseAssignmentExpression;
+         If Not (CurrentToken in [tjsComma,tjsSquaredBraceClose]) then
+           Error(SErrArrayEnd,[CurrentTokenString])
+         end;
+      end;
+    Consume(tjsSquaredBraceClose);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseObjectLiteral: TJSElement;
+
+Var
+  N : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+begin
+  Consume(tjsCurlyBraceOpen);
+  N:=TJSObjectLiteral(CreateElement(TJSObjectLiteral));
+  Result:=N;
+  try
+    While (CurrentToken<>tjsCurlyBraceClose) do
+      begin
+      While CurrentToken=tjsComma do
+         GetNextToken;
+      If (CurrentToken in [tjsIdentifier,jstoken.tjsString,tjsnumber]) then
+         begin
+         E:=N.Elements.AddElement;
+         E.Name:=CurrenttokenString;
+         GetNextToken;
+         end
+      else
+         Error(SErrObjectElement,[CurrentTokenString]);
+      Consume(tjsColon);
+      E.Expr:=ParseAssignmentExpression;
+      While CurrentToken=tjsComma do
+         GetNextToken;
+{      If Not (CurrentToken in [tjsComma,tjsCurlyBraceClose]) then
+        Error(SErrObjectEnd,[CurrentTokenString])}
+      end;
+    Consume(tjsCurlyBraceClose);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseNumericLiteral: TJSElement;
+
+Var
+  L : TJSLiteral;
+  D : Double;
+  I : Integer;
+
+begin
+  {$ifdef debugparser}  Writeln('Parsing numerical literal');{$endif debugparser}
+  Result:=Nil;
+  try
+    Val(CurrentTokenString,D,I);
+    If (I>0) then
+      Error(SErrInvalidnumber,[CurrentTokenString]);
+    L:=TJSLiteral(CreateElement(TJSLiteral));
+    GetNextToken;
+    L.Value.AsNumber:=D;
+    Result:=L;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseStringLiteral: TJSElement;
+
+Var
+  L : TJSLiteral;
+begin
+    {$ifdef debugparser} Writeln('Parsing string literal');{$endif debugparser}
+  Result:=Nil;
+  try
+    L:=TJSLiteral(CreateElement(TJSLiteral));
+    L.Value.AsString:=CurrentTokenString;
+    GetNextToken;
+    Result:=L;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseRegularExpressionLiteral: TJSElement;
+
+Var
+  S,pa,fl : String;
+  P : integer;
+  R : TJSRegularExpressionLiteral;
+begin
+  Result:=Nil;
+  If (CurrentToken=tjsRegex) then
+    begin
+    S:=CurrentTokenString;
+    P:=Length(S);
+    While (P>=1) and (S[P]<>'/') do
+      Dec(P);
+    If (P<=1) then
+      Error(SErrInvalidRegularExpression,[CurrentTokenString]);
+    pa:=Copy(S,2,P-1);
+    fl:=Copy(S,P,Length(S)-P+1);
+    R:=TJSRegularExpressionLiteral(CreateElement(TJSRegularExpressionLiteral));
+    Result:=R;
+    R.Pattern.AsString:=Pa;
+    R.PatternFlags.AsString:=Fl;
+    R.Argv[0]:=R.Pattern;
+    R.Argv[1]:=R.PatternFlags;
+    end;
+  try
+    Consume(tjsRegEx);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseLiteral: TJSElement;
+
+Var
+  L : TJSLiteral;
+
+begin
+  {$ifdef debugparser}Writeln('Parsing literal: ',GetEnumName(TypeInfo(TJSToken),Ord(CurrentToken)), ' As string: ',CurrentTokenString);{$endif debugparser}
+  Result:=Nil;
+  Case CurrentToken of
+    tjsNull : begin
+              L:=TJSLiteral(CreateElement(TJSLiteral));
+              Result:=L;
+              L.Value.IsNull:=True;
+              GetNextToken;
+              end;
+    tjsTrue,
+    tjsFalse: begin
+              L:=TJSLiteral(CreateElement(TJSLiteral));
+              Result:=L;
+              L.Value.AsBoolean:=(CurrentToken=tjsTrue);
+              GetNextToken;
+              end;
+    tjsNumber : Result:=ParseNumericLiteral;
+    jstoken.tjsString : Result:=ParseStringLiteral;
+    tjsDiv,
+    tjsDivEq : Result:=ParseRegularExpressionLiteral
+  else
+    Error(SErrLiteralExpected,[CurrentTokenString]);
+  end;
+end;
+
+function TJSParser.ParsePrimaryExpression: TJSElement;
+
+Var
+  R : TJSPrimaryExpressionIdent;
+
+begin
+  {$ifdef debugparser}  Writeln('ParsePrimaryExpression');{$endif debugparser}
+  Result:=Nil;
+  try
+    Case CurrentToken of
+      tjsThis :
+        begin
+        Result:=TJSPrimaryExpressionThis(CreateElement(TJSPrimaryExpressionThis));
+        GetNextToken;
+        end;
+      tjsidentifier:
+        begin
+        R:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent));
+        Result:=R;
+        R.Name:=CurrentTokenString;
+        GetNextToken;
+        end;
+      tjsSquaredBraceOpen: Result:=ParseArrayLiteral;
+      tjsCurlyBraceOpen: Result:=ParseObjectLiteral;
+      tjsBraceOpen:
+        begin
+        Consume(tjsBraceOpen);
+        Result:=ParseExpression;
+        Consume(tjsBraceClose);
+        end;
+    else
+      Result:=ParseLiteral;
+    end; // Case;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParsePrimaryExpression');{$endif debugparser}
+end;
+
+
+function TJSParser.ParseMemberExpression: TJSElement;
+
+Var
+  M  : TJSDotMemberExpression;
+  N  : TJSNewMemberExpression;
+  B  : TJSBracketMemberExpression;
+  Done : Boolean;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseMemberExpression');{$endif debugparser}
+  Case CurrentToken of
+    tjsFunction : Result:=ParseFunctionExpression();
+    tjsNew      : begin
+                  GetNextToken;
+                  N:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression));
+                  try
+                    Result:=N;
+                    N.MExpr:=ParseMemberExpression();
+                    if (CurrentToken=tjsBraceOpen) then
+                      N.Args:=ParseArguments;
+                  except
+                    FreeAndNil(N);
+                    Raise;
+                  end;
+                  end;
+  else
+    Result:=ParsePrimaryExpression()
+  end;
+  try
+    Done:=False;
+    Repeat
+      Case CurrentToken of
+       tjsDot :
+         begin
+         M:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression));
+         M.MExpr:=Result;
+         Result:=M;
+         GetNextToken;
+         If (CurrentToken=tjsIdentifier) then
+           M.Name:=CurrentTokenString;
+         Consume(tjsIdentifier);
+         end;
+       tjsSquaredBraceOpen:
+         begin
+         B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression));
+         B.MExpr:=Result;
+         Result:=B;
+         GetNextToken;
+         B.Name:=ParseExpression();
+         Consume(tjsSquaredBraceClose);
+         end;
+      else
+        Done:=True;
+        isLHS:=True;
+      end;
+    Until Done;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseMemberExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseArguments: TJSarguments;
+
+Var
+  E : TJSArrayLiteralElement;
+
+begin
+  Consume(tjsBraceOpen);
+  Result:=TJSArguments(CreateElement(TJSArguments));
+  try
+    While (CurrentToken<>tjsBraceClose) do
+      begin
+      E:=Result.Elements.AddElement;
+      E.Expr:=ParseAssignmentExpression;
+      If (CurrentToken<>tjsBraceClose) then
+        If CurrentToken=tjsComma then
+          GetNextToken
+        else
+          Error(SErrArgumentsExpected,[CurrentTokenString]);
+      end;
+    Consume(tjsBraceClose);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseLeftHandSideExpression: TJSElement;
+
+Var
+  M  : TJSDotMemberExpression;
+  B  : TJSBracketMemberExpression;
+  C : TJSCallExpression;
+  Done : Boolean;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseLeftHandSideExpression');{$endif debugparser}
+  Case CurrentToken of
+    tjsFunction : Result:=ParseFunctionExpression;
+    tjsNew      : Result:=ParseMemberExpression;
+  else
+    Result:=ParsePrimaryExpression
+  end;
+  try
+    Done:=False;
+    Repeat
+      Case CurrentToken of
+       tjsDot :
+         begin
+         M:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression));
+         M.MExpr:=Result;
+         Result:=M;
+         GetNextToken;
+         If (CurrentToken=tjsIdentifier) then
+           M.Name:=CurrentTokenString;
+         Consume(tjsIdentifier);
+         end;
+       tjsSquaredBraceOpen:
+         begin
+         B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression));
+         B.MExpr:=Result;
+         Result:=B;
+         GetNextToken;
+         B.Name:=ParseExpression;
+         Consume(tjsSquaredBraceClose);
+         end;
+       tjsBraceOpen:
+         begin
+         C:=TJSCallExpression(CreateElement(TJSCallExpression));
+         C.Expr:=Result;
+         Result:=C;
+         C.Args:=ParseArguments;
+         end;
+      else
+        {$ifdef debugparser}Writeln('Leaving LHS');{$endif debugparser}
+        Done:=True;
+        isLHS:=True;
+      end;
+    Until Done;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseLeftHandSideExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParsePostFixExpression: TJSElement;
+Var
+  R : TJSUnaryExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParsePostfixExpression');{$endif debugparser}
+  Result:=ParseLeftHandSideExpression;
+  Try
+  If (Not IsEndOfLine) and (CurrentToken in [tjsPlusPlus,tjsMinusMinus]) then
+    begin
+    If (CurrentToken=tjsPlusPLus) then
+      R:=TJSUnaryExpression(CreateElement(TJSUnaryPostPlusPlusExpression))
+    else
+      R:=TJSUnaryExpression(CreateElement(TJSUnaryPostMinusMinusExpression));
+    R.A:=Result;
+    Result:=R;
+    GetNextToken;
+    isLHS:=False;
+    end;
+  except
+    freeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParsePostfixExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseUnaryExpression: TJSElement;
+
+Var
+  C : TJSElementClass;
+  R : TJSUnaryExpression;
+
+begin
+  {$ifdef debugparser} Writeln('ParseUnaryExpression');{$endif debugparser}
+  C:=Nil;
+  Result:=Nil;
+  try
+    Case CurrentToken of
+      tjsDelete     : C:=TJSUnaryDeleteExpression;
+      tjsVoid       : C:=TJSUnaryVoidExpression;
+      tjsTypeOf     : C:=TJSUnaryTypeOfExpression;
+      tjsPlusPlus   : C:=TJSUnaryPrePlusPlusExpression;
+      tjsMinusMinus : C:=TJSUnaryPreMinusMinusExpression;
+      tjsPlus       : C:=TJSUnaryPlusExpression;
+      tjsMinus      : C:=TJSUnaryMinusExpression;
+      tjsInv        : C:=TJSUnaryInvExpression;
+      tjsNot        : C:=TJSUnaryNotExpression;
+    else
+      Result:=ParsePostFixExpression;
+    end;
+    If (Result=Nil) then
+      begin
+      {$ifdef debugparser} Writeln('Found Unary Expression',GetEnumName(TypeInfo(TJSToken),Ord(CurrentToken)), ' As string: ',CurrentTokenString);{$endif debugparser}
+      R:=TJSUnaryExpression(CreateElement(C));
+      Result:=R;
+      GetNextToken;
+      R.A:=ParseUnaryExpression();
+      isLHS:=False;
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser} Writeln('Exit ParseUnaryExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseMultiplicativeExpression: TJSElement;
+
+Var
+  C : TJSElementClass;
+  R : TJSMultiplicativeExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseMultiplicativeExpression');{$endif debugparser}
+  Result:=ParseUnaryExpression;
+  try
+    While (CurrentToken in [tjsMul,tjsDiv,tjsMod]) do
+      begin
+      if CurrentToken=tjsMul then
+        C:=TJSMultiplicativeExpressionMul
+      else if CurrentToken=tjsDiv then
+        C:=TJSMultiplicativeExpressionDiv
+      else
+        C:=TJSMultiplicativeExpressionMod;
+      R:=TJSMultiplicativeExpression(CreateElement(C));
+      GetNextToken;
+      R.A:=Result;
+      Result:=R;
+      R.B:=ParseUnaryExpression;
+      isLHS:=False;
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseMultiplicativeExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseAdditiveExpression: TJSElement;
+
+Var
+  C : TJSElementClass;
+  R : TJSAdditiveExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseAdditiveExpression');{$endif debugparser}
+  Result:=ParseMultiplicativeExpression;
+  try
+    While (CurrentToken in [tjsPlus,tjsMinus]) do
+      begin
+      if CurrentToken=tjsPlus then
+        C:=TJSAdditiveExpressionPlus
+      else
+        C:=TJSAdditiveExpressionMinus;
+      R:=TJSAdditiveExpression(CreateElement(C));
+      GetNextToken;
+      R.A:=Result;
+      Result:=R;
+      R.B:=ParseMultiplicativeExpression;
+      isLHS:=False;
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseAdditiveExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseShiftExpression: TJSElement;
+
+Var
+  C : TJSElementClass;
+  R : TJSShiftExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseShiftExpression');{$endif debugparser}
+  Result:=ParseAdditiveExpression;
+  try
+    While (CurrentToken in [tjsLshift,tjsRshift,tjsURShift]) do
+      begin
+      Case CurrentToken of
+        tjsLshift : C:=TJSLShiftExpression;
+        tjsRshift : C:=TJSRShiftExpression;
+        tjsURshift : C:=TJSURShiftExpression;
+      end;
+      R:=TJSShiftExpression(CreateElement(C));
+      R.A:=Result;
+      Result:=R;
+      GetNextToken;
+      R.B:=ParseAdditiveExpression;
+      IsLHS:=False;
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseShiftExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseRelationalExpression: TJSElement;
+
+Var
+  S : Set of TJSToken;
+  C : TJSElementClass;
+  R : TJSRelationalExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseRelationalExpression');{$endif debugparser}
+  Result:=ParseShiftExpression;
+  try
+    S:=[tjsLT,tjsGT,tjsLE,tjsGE,tjsInstanceOf];
+    If Not Noin then
+      Include(S,tjsIn);
+    While (CurrentToken in S) do
+      begin
+      Case CurrentToken of
+        tjsLT : C:=TJSRelationalExpressionLT;
+        tjsGT : C:=TJSRelationalExpressionGT;
+        tjsLE : C:=TJSRelationalExpressionLE;
+        tjsGE : C:=TJSRelationalExpressionGE;
+        tjsInstanceOf :C:=TJSRelationalExpressionInstanceOf;
+        tjsIn : C:=TJSRelationalExpressionIn;
+      end;
+      R:=TJSRelationalExpression(CreateElement(C));
+      R.A:=Result;
+      Result:=R;
+      GetNextToken;
+      R.B:=ParseRelationalExpression();
+      IsLHS:=False;
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseRelationalExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseEqualityExpression: TJSElement;
+
+Var
+  C : TJSElementClass;
+  E : TJSEqualityExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseEqualityExpression');{$endif debugparser}
+  Result:=ParseRelationalExpression;
+  try
+     While (CurrentToken in [tjsEq,tjsNE,tjsSEQ,tjsSNE]) do
+       begin
+       Case CurrentToken of
+         tjsEq : C:=TJSEqualityExpressionEQ;
+         tjsNE : C:=TJSEqualityExpressionNE;
+         tjsSEQ : C:=TJSEqualityExpressionSEQ;
+         tjsSNE : C:=TJSEqualityExpressionSNE;
+       end;
+       GetNextToken;
+       E:=TJSEqualityExpression(CreateElement(C));
+       Result:=E;
+       E.A:=Result;
+       E.B:=ParseEqualityExpression();
+       E:=Nil;
+       IsLHS:=False;
+       end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseEqualityExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseBitwiseAndExpression: TJSElement;
+
+Var
+  L : TJSBitwiseAndExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseBitwiseAndExpression');{$endif debugparser}
+  Result:=ParseEqualityExpression;
+  try
+    If (CurrentToken<>tjsAnd) then
+      exit;
+    GetNextToken;
+    L:=TJSBitwiseAndExpression(CreateElement(TJSBitwiseAndExpression));
+    L.A:=Result;
+    Result:=L;
+    L.B:=ParseBitwiseAndExpression();
+    IsLHS:=False;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseBitwiseAndExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseBitwiseXORExpression: TJSElement;
+
+Var
+  L : TJSBitwiseXOrExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseBitwiseXorExpression');{$endif debugparser}
+  Result:=ParseBitwiseAndExpression;
+  try
+    If (CurrentToken<>tjsXOr) then
+      exit;
+    GetNextToken;
+    L:=TJSBitwiseXOrExpression(CreateElement(TJSBitwiseXOrExpression));
+    L.A:=Result;
+    Result:=L;
+    L.B:=ParseBitwiseXORExpression();
+    IsLHS:=False;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseBitwiseXorExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseBitwiseORExpression: TJSElement;
+
+Var
+  L : TJSBitwiseOrExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseBitWiseOrExpression');{$endif debugparser}
+    Result:=ParseBitwiseXORExpression;
+    try
+      If (CurrentToken<>tjsOr) then
+        exit;
+      GetNextToken;
+      L:=TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression));
+      L.A:=Result;
+      Result:=L;
+      L.B:=ParseBitwiseORExpression();
+      IsLHS:=False;
+    except
+      FreeAndNil(Result);
+      Raise;
+    end;
+    {$ifdef debugparser}  Writeln('Exit ParseBitWiseOrExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseLogicalAndExpression: TJSElement;
+
+Var
+  L : TJSLogicalAndExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseLogicalAndExpression');{$endif debugparser}
+  Result:=ParseBitwiseORExpression;
+  try
+    If (CurrentToken<>tjsAndAnd) then
+      exit;
+    GetNextToken;
+    L:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression));
+    L.A:=Result;
+    Result:=L;
+    L.B:=ParseLogicalAndExpression();
+    IsLHS:=False;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseLogicalAndExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseLogicalORExpression: TJSElement;
+
+Var
+  L : TJSLogicalOrExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseLogicalOrExpression');{$endif debugparser}
+  Result:=ParseLogicalAndExpression;
+  try
+    If (CurrentToken<>tjsOROR) then
+      exit;
+    GetNextToken;
+    L:=TJSLogicalOrExpression(CreateElement(TJSLogicalOrExpression));
+    L.A:=Result;
+    Result:=L;
+    L.B:=ParseLogicalOrExpression();
+    IsLHS:=False;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseLogicalOrExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseConditionalExpression: TJSElement;
+
+Var
+  N : TJSConditionalExpression;
+  L : TJSElement;
+begin
+  {$ifdef debugparser}  Writeln('ParseConditionalExpression');{$endif debugparser}
+  Result:=Nil;
+  Result:=ParseLogicalORExpression;
+  try
+    If (CurrentToken=tjsConditional) then
+      begin
+      {$ifdef debugparser}  Writeln('ParseConditionalExpression : Detected conditional ');{$endif debugparser}
+      GetNextToken;
+      L:=Result;
+      N:=TJSConditionalExpression(CreateElement(TJSConditionalExpression));
+      Result:=N;
+      N.A:=L;
+      L:=Nil;
+      N.B:=ParseAssignmentExpression;
+      Consume(tjsColon);
+      N.C:=ParseAssignmentExpression;
+      IsLHS:=False;
+      end;
+  except
+    FreeandNil(Result);
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseConditionalExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseAssignmentExpression: TJSElement;
+
+Var
+  N : TJSElement;
+  C : TJSElementClass;
+  A : TJSAssignStatement;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseAssignmentExpression');{$endif debugparser}
+  Result:=Nil;
+  N:=ParseConditionalExpression;
+  If not isLHS then
+    Result:=N
+  else
+    Case CurrentToken of
+      tjsAssign    : C:=TJSSimpleAssignStatement;
+      tjsMulEq     : C:=TJSMulEqAssignStatement;
+      tjsDivEq     : C:=TJSDivEqAssignStatement;
+      tjsModEq     : C:=TJSModEqAssignStatement;
+      tjsPlusEq    : C:=TJSAddEqAssignStatement;
+      tjsMinusEq   : C:=TJSSubEqAssignStatement;
+      tjsLShiftEq  : C:=TJSLShiftEqAssignStatement;
+      tjsRShiftEq  : C:=TJSRShiftEqAssignStatement;
+      tjsURShiftEq : C:=TJSURShiftEqAssignStatement;
+      tjsANDEq     : C:=TJSANDEqAssignStatement;
+      tjsOREq      : C:=TJSOREqAssignStatement;
+      tjsXOREq     : C:=TJSXOREqAssignStatement;
+    else
+//      writeln('Strange token',GetEnumName(TypeInfo(TJSToken),Ord(CurrentToken)), ' As string: ',CurrentTokenString);
+      Result:=N
+    end;
+  If Result<>Nil then
+    begin
+    {$ifdef debugparser}  Writeln('Exit ParseAssignmentExpression - no assignment');{$endif debugparser}
+    Exit;
+    end;
+  A:=TJSAssignStatement(CreateElement(C));
+  try
+    Result:=A;
+    A.Lhs:=N;
+    GetNextToken;
+    {$ifdef debugparser}  Writeln('ParseAssignmentExpression - level 2');{$endif debugparser}
+    N:=ParseAssignmentExpression();
+    {$ifdef debugparser}  Writeln('Exit ParseAssignmentExpression - level 2');{$endif debugparser}
+    A.Expr:=N;
+    IsLhs:=False;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseAssignmentExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseVariableDeclaration: TJSElement;
+
+Var
+  V : TJSVarDeclaration;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseVariableDeclaration');{$endif debugparser}
+  V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration));;
+  try
+    V.Name:=CurrenttokenString;
+    Consume(tjsIdentifier);
+    if (CurrentToken=tjsAssign) then
+      begin
+      GetNextToken;
+      V.Init:=ParseAssignmentExpression;
+      end;
+    Result:=V;
+    FCurrentVars.AddNode.Node:=Result;
+  except
+    FreeAndNil(V);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseVariableDeclaration');{$endif debugparser}
+end;
+
+function TJSParser.ParseVariableDeclarationList: TJSElement;
+
+Var
+  E,N : TJSElement;
+  L : TJSVariableDeclarationList;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseVariableDeclarationList entry');{$endif debugparser}
+  E:=ParseVariableDeclaration;
+  If (CurrentToken<>tjsComma) then
+    Result:=E
+  else
+    begin
+    L:=TJSVariableDeclarationList(CreateElement(TJSVariableDeclarationList));
+    Result:=L;
+    try
+      Consume(tjsComma);
+      N:=ParseVariableDeclarationList();
+      L.A:=E;
+      L.B:=N;
+    except
+      FreeAndNil(Result);
+      Raise;
+    end;
+    end;
+  {$ifdef debugparser}  Writeln('ParseVariableDeclarationList exit');{$endif debugparser}
+end;
+
+function TJSParser.ParseVariableStatement : TJSElement;
+
+Var
+  V : TJSVariableStatement;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseVariableStatement entry');{$endif debugparser}
+  Result:=Nil;
+  Consume(tjsVar);
+  Result:=ParseVariableDeclarationList;
+  try
+    Consume(tjsSemicolon,true);
+    V:=TJSVariableStatement(CreateElement(TJSVariableStatement));
+    V.A:=Result;
+    Result:=V;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('ParseVariableStatement exit');{$endif debugparser}
+end;
+
+function TJSParser.ParseEmptyStatement : TJSElement;
+
+begin
+  Consume(tjsSemiColon,true);
+  Result:=CreateElement(TJSEmptyStatement);
+end;
+
+function TJSParser.ParseIfStatement : TJSElement;
+
+Var
+  C,BTrue,BFalse : TJSElement;
+  I : TJSIFstatement;
+
+begin
+  C:=Nil;
+  BTrue:=Nil;
+  BFalse:=Nil;
+  try
+    Consume(tjsIF);
+    Consume(tjsBraceOpen);
+    C:=ParseExpression;
+    Consume(tjsBraceClose);
+    BTrue:=ParseStatement;
+    If (CurrentToken=tjsElse) then
+      begin
+      Consume(tjsElse);
+      BFalse:=ParseStatement;
+      end;
+    I:=TJSIfStatement(CreateElement(TJSIfStatement));
+    I.Cond:=C;
+    I.BTrue:=Btrue;
+    I.BFalse:=BFalse;
+    Result:=I;
+  except
+    FreeAndNil(C);
+    FreeAndNil(BTrue);
+    FreeAndNil(BFalse);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseIterationStatement : TJSElement;
+
+Var
+  F : TJSForStatement;
+  FI : TJSForInStatement;
+  W : TJSWhileStatement;
+  N : TJSElement;
+
+begin
+  Result:=Nil;
+  N:=Nil;
+  CurrentLabelSet.Continuable:=True;
+  EnterLabel(SEmptyLabel);
+  try
+    try
+    Case CurrentToken of
+      tjsDo :
+        begin
+        GetNextToken;
+        W:=TJSDoWhileStatement(CreateElement(TJSDoWhileStatement));
+        Result:=W;
+        W.Body:=ParseStatement;
+        Consume(tjsWhile);
+        Consume(tjsBraceOpen);
+        W.Cond:=ParseExpression;
+        Consume(tjsBraceClose);
+        Consume(tjsSemicolon,True);
+        end;
+      tjsWhile :
+        begin
+        GetNextToken;
+        W:=TJSWhileStatement(CreateElement(TJSWhileStatement));
+        Result:=W;
+        Consume(tjsBraceOpen);
+        W.Cond:=ParseExpression;
+        Consume(tjsBraceClose);
+        W.Body:=ParseStatement;
+        Result:=W;
+        end;
+      else
+        // For ?
+        GetNextToken;
+        Consume(tjsBraceopen);
+        If (CurrentToken=tjsVar) then
+          begin
+          GetNextToken;
+          N:=ParseVariableDeclarationList;
+          // for (var in
+          If (CurrentToken=tjsIn) and (N is tJSVarDeclaration) then
+            begin
+            Fi:=TJSForInStatement(CreateElement(TJSForInStatement));
+            Result:=Fi;
+            Fi.LHS:=N;
+            GetNextToken;
+            Fi.List:=ParseExpression;
+            Consume(tjsBraceClose);
+            Fi.Body:=ParseStatement;
+            end;
+          // for (var ;
+          If (CurrentToken<>tjsSemicolon) then
+            If (N is tJSVarDeclaration) then
+              Error(SErrSemicolonOrInExpected,[CurrentTokenString])
+            else
+              Error(SErrSemicolonExpected,[CurrentTokenString]);
+          GetNextToken;
+          F:=TJSForStatement(CreateElement(TJSForStatement));
+          Result:=F;
+          If (CurrentToken<>tjsSemicolon) then
+            F.Cond:=ParseExpression;
+          Consume(tjsSemicolon);
+          If (CurrentToken<>tjsBraceClose) then
+            F.Incr:=ParseExpression;
+          Consume(tjsBraceClose);
+          F.Body:=ParseStatement;
+          end
+        else
+          begin
+          If (CurrentToken<>tjsSemicolon) then
+            begin
+            N:=ParseExpression;
+            If (CurrentToken=tjsIn) then
+              begin
+              Fi:=TJSForInStatement(CreateElement(TJSForInStatement));
+              Result:=Fi;
+              Fi.LHS:=N;
+              N:=Nil; // prevent freeing a second time in case of an exception.
+              GetNextToken;
+              Fi.List:=ParseExpression;
+              Consume(tjsBraceClose);
+              Fi.Body:=ParseStatement;
+              Exit; // We must jump out here
+              end
+            end
+          else
+            N:=Nil;
+          // For ( Init; Cond; incr)
+          F:=TJSForStatement(CreateElement(TJSForStatement));
+          Result:=F;
+          F.Init:=N;
+          N:=Nil; // prevent freeing a second time in case of an exception.
+          Consume(tjsSemicolon);
+          if (CurrentToken<>tjsSemicolon) then
+            F.Cond:=ParseExpression;
+          Consume(tjsSemicolon);
+          If (CurrentToken<>tjsBraceClose) Then
+            F.Incr:=ParseExpression;
+          Consume(tjsBraceClose);
+          F.Body:=ParseStatement;
+          end;
+      end; // Case
+  Finally
+    LeaveLabel;
+    FreeCurrentLabelSet;
+  end;
+  except
+    FreeAndNil(N);
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseContinueStatement : TJSElement;
+
+Var
+  L : TJSLabel;
+  C : TJSContinueStatement;
+
+begin
+  C:=TJSContinueStatement(CreateElement(TJSContinueStatement));
+  try
+    Result:=C;
+    Consume(tjsContinue);
+    If (CurrentToken=tjsSemicolon) then
+      L:=LookupLabel(SEmptyLabel,tjsContinue)
+    else
+      begin
+      if (CurrentToken=tjsIdentifier) then
+        L:=LookupLabel(CurrentTokenString,tjsContinue);
+      Consume(tjsIdentifier);
+      end;
+    Consume(tjsSemicolon,True);
+    C.Target:=L.Labelset.Target;
+    C.TargetName:=L.Name;
+  except
+    FreeAndNil(C);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseBreakStatement : TJSElement;
+
+Var
+  L : TJSLabel;
+  B : TJSBreakStatement;
+
+begin
+  B:=TJSBreakStatement(CreateElement(TJSBreakStatement));
+  try
+  Result:=B;
+    Consume(tjsBreak);
+    If (CurrentToken=tjsSemicolon) then
+      L:=LookupLabel(SEmptyLabel,tjsBreak)
+    else
+      begin
+      if (CurrentToken=tjsIdentifier) then
+        L:=LookupLabel(CurrentTokenString,tjsBreak);
+      Consume(tjsIdentifier);
+      end;
+    Consume(tjsSemicolon,True);
+    B.Target:=L.Labelset.Target;
+    B.TargetName:=L.Name;
+  except
+    FreeAndNil(B);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseReturnStatement : TJSElement;
+
+Var
+  R : TJSreturnStatement;
+
+begin
+  R:=TJSReturnStatement(CreateElement(TJSReturnStatement));
+  try
+    Result:=R;
+    Consume(tjsReturn);
+    If (FunctionDepth=0) then
+      Error(SErrReturnNotInFunction);
+    If Not (CurrentToken in [tjsSemicolon,tjsCurlyBraceClose]) then
+      R.Expr:=ParseExpression;
+    Consume(tjsSemicolon,True);
+  except
+    FreeAndNil(R);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseWithStatement : TJSElement;
+
+Var
+  W : TJSWithStatement;
+begin
+  W:=TJSWithStatement(CreateElement(TJSWithStatement));
+  try
+    Consume(tjsWith);
+    Consume(tjsBraceOpen);
+    W.A:=ParseExpression;
+    Consume(tjsBraceClose);
+    W.B:=ParseStatement;
+  except
+    FreeAndNil(W);
+    Raise;
+  end;
+  Result:=W;
+end;
+
+function TJSParser.ParseSwitchStatement : TJSElement;
+
+
+Var
+  N : TJSSwitchStatement;
+  Ca : TJSCaseElement;
+
+begin
+  N:=TJSSwitchStatement(CreateElement(TJSSwitchStatement));
+  try
+    N.Target:=CurrentLabelset.Target;
+    EnterLabel(SEmptyLabel);
+    try
+      Consume(tjsSwitch);
+      Consume(tjsBraceOpen);
+      N.Cond:=ParseExpression;
+      Consume(tjsBraceClose);
+      Consume(tjsCurlyBraceOpen);
+      While (CurrentToken<>tjsCurlyBraceClose) do
+        begin
+        If (CurrentToken=tjsCase) then
+          begin
+          GetNextToken;
+          Ca:=N.Cases.AddCase;
+          Ca.Expr:=ParseExpression;
+          end
+        else if (CurrentToken=tjsDefault) then
+          begin
+          If (N.TheDefault<>Nil) then
+            Error(SerrDuplicateSwitchDefault);
+          Ca:=N.Cases.AddCase;
+          N.TheDefault:=Ca;
+          GetNextToken;
+          end
+        else
+          Error(SerrCaseEndExpected);
+        Consume(tjsColon);
+        If Not (CurrentToken in [tjsCurlyBraceClose,tjsCase,tjsDefault]) then
+          Ca.Body:=ParseStatementList;
+        end;
+      Consume(tjsCurlyBraceClose);
+    finally
+      LeaveLabel;
+      FreeCurrentLabelSet;
+    end;
+    Result:=N;
+  except
+    FreeAndNil(N);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseThrowStatement : TJSElement;
+
+Var
+  TS : TJSThrowStatement;
+
+begin
+  TS:=TJSThrowStatement(CreateElement(TJSThrowStatement));
+  try
+    Result:=TS;
+    Consume(tjsThrow);
+    If IsEndOfLine then
+      Error(SErrNewlineAfterThrow);
+    TS.A:=ParseExpression;
+    Consume(tjsSemicolon,true);
+  except
+    FreeAndNil(TS);
+    Raise;
+  end;
+end;
+
+function TJSParser.ParseTryStatement : TJSElement;
+
+Var
+  BO,BC,BF : TJSElement;
+  Id : jstree.TJSString;
+  T : TJSTryStatement;
+
+begin
+  BO:=Nil;
+  BC:=Nil;
+  BF:=Nil;
+  Result:=Nil;
+  Consume(tjsTry);
+  try
+    Bo:=ParseBlock;
+    if (CurrentToken=tjscatch) then
+      begin
+      Consume(tjsCatch);
+      Consume(tjsBraceOpen);
+      if (CurrentToken=tjsIdentifier) then
+        id:=CurrentTokenString;
+      Consume(tjsIdentifier);
+      Consume(tjsBraceClose);
+      BC:=ParseBlock;
+      end;
+    if (CurrentToken=tjsFinally) then
+      begin
+      consume(tjsFinally);
+      BF:=ParseBlock;
+      end;
+    If (BF=Nil) and (BC=Nil) then
+      Error(SErrCatchFinallyExpected);
+    If Assigned(BC) AND Assigned(BF) then
+      T:=TJSTryStatement(CreateElement(TJSTryCatchFinallyStatement))
+    else if Assigned(BC) then
+      T:=TJSTryStatement(CreateElement(TJSTryCatchStatement))
+    else
+      T:=TJSTryStatement(CreateElement(TJSTryFinallyStatement));
+    Result:=T;
+    T.Block:=Bo;
+    Bo:=Nil;
+    T.BCatch:=BC;
+    BC:=Nil;
+    T.BFinally:=BF;
+    BF:=Nil;
+    T.Ident:=ID;
+  except
+    FreeAndNil(Bo);
+    FreeAndNil(BC);
+    FreeAndNil(BF);
+    FreeAndNil(Result);
+    Raise;
+  end;
+
+end;
+
+function TJSParser.ParseFunctionExpression : TJSFunctionDeclarationStatement;
+
+Var
+  Oni,olhs: Boolean;
+  F : TJSFunctionDeclarationStatement;
+  N : String;
+  Args : TStrings;
+
+begin
+  {$ifdef debugparser} Writeln('>>> ParseFunctionExpression');{$endif}
+  oni:=NoIn;
+  olhs:=IsLHS;
+  F:=Nil;
+  Args:=Nil;
+  try
+    NoIn:=False;
+    IsLHS:=False;
+    F:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement));
+    try
+      Consume(tjsFunction);
+      if (CurrentToken=tjsIdentifier) then
+        begin
+        n:=CurrentTokenstring;
+        GetNextToken;
+        end
+      else
+        n:='';
+      if n='' then ; // what to do with that?
+      Consume(tjsBraceOpen);
+      F.AFunction:= TJSFuncDef.Create;
+      Args:=ParseFormalParameterList;
+      try
+        If Assigned(Args) then
+          F.AFunction.Params.Assign(Args);
+      finally
+        FreeAndNil(Args);
+      end;
+      Consume(tjsBraceClose);
+      Consume(tjsCurlyBraceOpen);
+      Inc(FFunctionDepth);
+      try
+        F.AFunction.Body:=ParseFunctionBody;
+      Finally
+        Dec(FFunctionDepth);
+      end;
+      Consume(tjsCurlyBraceClose);
+      Result:=F;
+    except
+      FreeAndNil(F);
+      Raise;
+    end;
+  finally
+    NoIn  := oni;
+    IsLHS := olhs;
+  end;
+  {$ifdef debugparser} Writeln('<<< ParseFunctionExpression');{$endif}
+end;
+
+function TJSParser.ParseFunctionStatement : TJSElement;
+
+Var
+  F : TJSFunctionDeclarationStatement;
+  I : TJSPrimaryExpressionIdent;
+  A : TJSAssignStatement;
+  E : TJSExpressionStatement;
+
+begin
+  {$ifdef debugparser} Writeln('>>> ParseFunctionStatement');{$endif}
+  F:=Nil;
+  I:=Nil;
+  A:=Nil;
+  try
+    F:=ParseFunctionExpression;
+    I:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent));
+    I.Name:=F.AFunction.Name;
+    A:=TJSAssignStatement(CreateElement(TJSAssignStatement));
+    A.LHS:=I;
+    I:=Nil;
+    A.Expr:=F;
+    F:=Nil;
+    E:=TJSExpressionStatement(CreateElement(TJSExpressionStatement));
+    E.A:=A;
+    A:=Nil;
+    Result:=E;
+  except
+    FreeAndNil(F);
+    FreeAndNil(I);
+    FreeAndNil(A);
+    Raise;
+  end;
+  {$ifdef debugparser} Writeln('<<< ParseFunctionStatement');{$endif}
+end;
+
+function TJSParser.ParseLabeledStatement : TJSElement;
+
+Var
+  OL : TJSLabelSet;
+  LS : TJSLabeledStatement;
+begin
+  LS:=TJSLabeledStatement(CreateElement(TJSLabeledStatement));
+  try
+    Result:=LS;
+    OL:=FCurrentLabelSet;
+    try
+      FCurrentLabelSet:=Nil;
+      LS.target:=CurrentLabelSet.Target;
+      Repeat
+        LS.TheLabel:=EnterLabel(CurrentTokenString);
+        Consume(tjsIdentifier);
+        Consume(tjsColon);
+      Until (CurrentToken<>tjsIdentifier) or (PeekNextToken<>tjsColon);
+      Case CurrentToken of
+         tjsDo,tjsWhile,tjsFor : LS.A:=ParseIterationStatement;
+         tjsswitch : LS.A:=ParseSwitchStatement;
+      else
+        LS.A:=ParseStatement;
+      end;
+    finally
+      FreeCurrentLabelSet;
+      FCurrentLabelSet:=Ol;
+    end;
+  except
+    FreeAndNil(LS);
+    Raise;
+  end;
+end;
+
+procedure TJSParser.FreeCurrentLabelSet;
+
+Var
+  L : TJSLabelSet;
+
+begin
+  While Assigned(FCurrentLabelSet) do
+    begin
+    L:=FCurrentLabelset.Next;
+    FCurrentLabelSet.Free;
+    FCurrentLabelSet:=L;
+    end;
+end;
+
+function TJSParser.ParseExpressionStatement : TJSElement;
+
+Var
+  E : TJSElement;
+  R : TJSExpressionStatement;
+begin
+  {$ifdef debugparser}  Writeln('ParseExpressionStatement');{$endif debugparser}
+  E:=ParseExpression;
+  Consume(tjsSemicolon,True);
+  R:=TJSExpressionStatement(CreateElement(TJSExpressionStatement));
+  R.A:=E;
+  Result:=R;
+  {$ifdef debugparser}  Writeln('Exit ParseExpressionStatement');{$endif debugparser}
+end;
+
+function TJSParser.ParseExpression : TJSElement;
+
+Var
+  C : TJSCommaExpression;
+
+begin
+  {$ifdef debugparser}  Writeln('ParseExpression');{$endif debugparser}
+  Result:=ParseAssignmentExpression;
+  try
+    If (CurrentToken=tjsComma) then
+      begin
+      C:=TJSCommaExpression(CreateElement(TJSCommaExpression));
+      C.A:=Result;
+      Result:=C;
+      GetNextToken;
+      C.B:=ParseExpression();
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}  Writeln('Exit ParseExpression');{$endif debugparser}
+end;
+
+function TJSParser.ParseStatement : TJSElement;
+
+begin
+  {$ifdef debugparser} Writeln('>>> Parsestatement');{$endif}
+  Result:=Nil;
+  Case CurrentToken of
+    tjsCurlyBraceOpen :
+      Result:=ParseBlock;
+    tjsVar:
+      Result:=ParseVariableStatement;
+    tjsSemicolon:
+      Result:=ParseEmptyStatement;
+    tjsIf:
+      Result:=ParseIfStatement;
+    tjsDo,tjsWhile,tjsFor:
+      Result:=ParseIterationStatement;
+    tjsContinue:
+      Result:=ParseContinueStatement;
+    tjsBreak:
+      Result:=ParseBreakStatement;
+    tjsReturn:
+      Result:=ParseReturnStatement;
+    tjsWith:
+      Result:=ParseWithStatement;
+    tjsSwitch:
+      Result:=ParseSwitchStatement;
+    tjsThrow:
+      Result:=ParseThrowStatement;
+    tjsTry:
+      Result:=ParseTryStatement;
+    tjsFunction:
+      begin
+      If (PeekNextToken<>tjsBraceOpen) then
+        Result:=ParseFunctionStatement;
+      Error(SErrFunctionNotAllowedHere);
+      end;
+    tjsIdentifier:
+      If (PeekNextToken=tjsColon) then
+        Result:=ParseLabeledStatement
+      else
+        Result:=ParseExpressionStatement;
+  else
+    Result:=ParseExpressionStatement;
+  end;
+  {$ifdef debugparser} If Assigned(Result) then Writeln('<<< Parsestatement ',Result.ClassName) else Writeln('<<< Parsestatement (null');{$endif}
+end;
+
+function TJSParser.ParseSourceElements : TJSSourceElements;
+
+Const
+  StatementTokens = [tjsNULL, tjsTRUE, tjsFALSE,
+      tjsTHIS, tjsIdentifier,jstoken.tjsSTRING,tjsNUMBER,
+      tjsBraceOpen,tjsCurlyBraceOpen,tjsSquaredBraceOpen,
+      tjsNew,tjsDelete,tjsVoid,tjsTypeOf,
+      tjsPlusPlus,tjsMinusMinus,
+      tjsPlus,tjsMinus,tjsNot,tjsNE,tjsSNE,tjsSemicolon,
+      tjsVAR,tjsIF,tjsDO,tjsWHILE,tjsFOR,jstoken.tjsCONTINUE,jstoken.tjsBREAK,jstoken.tjsReturn,
+      tjsWith,jstoken.tjsSWITCH,tjsThrow,TjsTry,tjsDIV,tjsDIVEQ];
+
+Var
+  F : TJSFunctionDeclarationStatement;
+  E : TJSElement;
+  Done : Boolean;
+  VS : TJSElementNodes;
+begin
+  {$ifdef debugparser} Writeln('>>> Entering source elements');{$endif}
+  Result:=TJSSourceElements(CreateElement(TJSSourceElements));
+  try
+    Done:=False;
+    VS:=FCurrentVars;
+    Try
+      FCurrentVars:=Result.Vars;
+      Repeat
+        {$ifdef debugparser} Writeln('Sourceelements start:',GetEnumName(TypeInfo(TJSToken),Ord(CurrentToken)), ' As string: ',CurrentTokenString);{$endif debugparser}
+        If (CurrentToken=jstoken.tjsFunction) then
+          begin
+          If (PeekNextToken<>tjsBraceOpen) then
+            begin
+            F:=Self.ParseFunctionDeclaration;
+            Result.Functions.AddNode.Node:=F;
+            end
+          else
+            begin
+            {$ifdef debugparser} Writeln('Function expression detected');{$endif}
+            E:=Self.ParseStatement;
+            Result.Statements.AddNode.Node:=E;
+            end;
+          end
+        else if CurrentToken in StatementTokens then
+          begin
+          E:=Self.ParseStatement;
+          Result.Statements.AddNode.Node:=E;
+          end
+        else
+          Done:=True;
+        {$ifdef debugparser} Writeln('Sourceelements Done : ',Done);{$endif}
+      Until Done;
+    Finally
+      FCurrentVars:=VS;
+    end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser}   Writeln('<<< Exiting source elements');{$endif}
+end;
+
+function TJSParser.ParseFunctionBody : TJSFunctionBody;
+
+Var
+  E : TJSElement;
+
+begin
+  {$ifdef debugparser} Writeln('>>> Entering FunctionBody');{$endif}
+  Result:=TJSFunctionBody(CreateElement(TJSFunctionBody));
+  try
+    E:=Self.ParseSourceElements;
+    Result.A:=E;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser} Writeln('<<< Exiting FunctionBody');{$endif}
+end;
+
+Function TJSParser.ParseProgram: TJSFunctionDeclarationStatement;
+
+Var
+  B : TJSElement;
+begin
+  {$ifdef debugparser} Writeln('>>> Entering FunctionDeclarationStatement');{$endif}
+  B:=Parse;
+  If Not (B is TJSFunctionBody) then
+    Error('Parse did not result in functionbody');
+  Result:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement));
+  Result.AFunction:=TJSFuncDef.Create;
+  Result.AFunction.Body:=TJSFunctionBody(B);
+  {$ifdef debugparser} Writeln('<<< Exiting FunctionDeclarationStatement');{$endif}
+end;
+
+Function TJSParser.Parse: TJSElement;
+
+Var
+  Body : TJSElement;
+
+begin
+  {$ifdef debugparser} Writeln('>>> Parse');{$endif}
+  Result:=Nil;
+  CheckParser;
+  GetNextToken;
+  Body:=ParseFunctionBody;
+  Result:=Body;
+  try
+    if (CurrentToken<>tjsEOF) then
+      begin
+      if (CurrentToken=tjsCurlyBraceClose) then
+        Error(SErrUnmatchedCurlyBrace)
+      else if (CurrentToken=tjsBraceClose) then
+        Error(SerrUnmatchedBrace)
+      else if (CurrentToken=tjsSquaredBraceClose) then
+        Error(SerrUnmatchedSquareBrace);
+      Error(SErrUnexpectedToken,[CurrentTokenString]);
+      end;
+    If (Body is TJSFunctionBody) then
+      TJSFunctionBody(Body).isProgram:=True;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+  {$ifdef debugparser} Writeln('<<< Parse');{$endif}
+end;
+
+
+end.
+

+ 903 - 0
compiler/packages/fcl-js/src/jsscanner.pp

@@ -0,0 +1,903 @@
+{
+    This file is part of the Free Component Library
+
+    ECMAScript (JavaScript) source lexical scanner
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+{$h+}
+
+unit JSScanner;
+
+interface
+
+uses SysUtils, Classes, jstoken;
+
+resourcestring
+  SErrInvalidCharacter = 'Invalid character ''%s''';
+  SErrOpenString = 'string exceeds end of line';
+  SErrIncludeFileNotFound = 'Could not find include file ''%s''';
+  SErrIfXXXNestingLimitReached = 'Nesting of $IFxxx too deep';
+  SErrInvalidPPElse = '$ELSE without matching $IFxxx';
+  SErrInvalidPPEndif = '$ENDIF without matching $IFxxx';
+  SInvalidHexadecimalNumber = 'Invalid decimal number';
+  SErrInvalidNonEqual = 'Syntax Error: != or !== expected';
+  SErrInvalidRegularExpression = 'Syntax error in regular expression: / expected, got: %s';
+
+Type
+  TLineReader = class
+  public
+    function IsEOF: Boolean; virtual; abstract;
+    function ReadLine: string; virtual; abstract;
+  end;
+
+  { TStreamLineReader }
+
+  TStreamLineReader = class(TLineReader)
+  private
+    FStream : TStream;
+    Buffer : Array[0..1024] of Byte;
+    FBufPos,
+    FBufLen : Integer;
+    procedure FillBuffer;
+  public
+    Constructor Create(AStream : TStream);
+    function IsEOF: Boolean; override;
+    function ReadLine: string; override;
+  end;
+
+  TFileLineReader = class(TLineReader)
+  private
+    FTextFile: Text;
+    FileOpened: Boolean;
+  public
+    constructor Create(const AFilename: string);
+    destructor Destroy; override;
+    function IsEOF: Boolean; override;
+    function ReadLine: string; override;
+  end;
+
+  EJSScannerError       = class(Exception);
+
+  { TJSScanner }
+
+  TJSScanner = class
+  private
+    FReturnComments: Boolean;
+    FReturnWhiteSpace: Boolean;
+    FSourceFile: TLineReader;
+    FSourceFilename: string;
+    FCurRow: Integer;
+    FCurToken: TJSToken;
+    FCurTokenString: string;
+    FCurLine: string;
+    TokenStr: PChar;
+    FWasEndOfLine : Boolean;
+    FSourceStream : TStream;
+    FOwnSourceFile : Boolean;
+    function CommentDiv: TJSToken;
+    function DoIdentifier : TJSToken;
+    function DoMultiLineComment: TJSToken;
+    function DoNumericLiteral: TJSToken;
+    function DoSingleLineComment: TJSToken;
+    function DoStringLiteral: TJSToken;
+    function DoWhiteSpace: TJSToken;
+    function FetchLine: Boolean;
+    function GetCurColumn: Integer;
+    function ReadUnicodeEscape: WideChar;
+    Function ReadRegex : TJSToken;
+  protected
+    procedure Error(const Msg: string);overload;
+    procedure Error(const Msg: string; Args: array of Const);overload;
+  public
+    constructor Create(ALineReader: TLineReader);
+    constructor Create(AStream : TStream);
+    destructor Destroy; override;
+    procedure OpenFile(const AFilename: string);
+    Function FetchRegexprToken: TJSToken;
+    Function FetchToken: TJSToken;
+    Function IsEndOfLine : Boolean;
+    Property WasEndOfLine : Boolean Read FWasEndOfLine;
+    Property ReturnComments : Boolean Read FReturnComments Write FReturnComments;
+    Property ReturnWhiteSpace : Boolean Read FReturnWhiteSpace Write FReturnWhiteSpace;
+    property SourceFile: TLineReader read FSourceFile;
+    property CurFilename: string read FSourceFilename;
+    property CurLine: string read FCurLine;
+    property CurRow: Integer read FCurRow;
+    property CurColumn: Integer read GetCurColumn;
+    property CurToken: TJSToken read FCurToken;
+    property CurTokenString: string read FCurTokenString;
+  end;
+
+
+implementation
+
+
+constructor TFileLineReader.Create(const AFilename: string);
+begin
+  inherited Create;
+  Assign(FTextFile, AFilename);
+  Reset(FTextFile);
+  FileOpened := true;
+end;
+
+destructor TFileLineReader.Destroy;
+begin
+  if FileOpened then
+    Close(FTextFile);
+  inherited Destroy;
+end;
+
+function TFileLineReader.IsEOF: Boolean;
+begin
+  Result := EOF(FTextFile);
+end;
+
+function TFileLineReader.ReadLine: string;
+begin
+  ReadLn(FTextFile, Result);
+end;
+
+constructor TJSScanner.Create(ALineReader: TLineReader);
+begin
+  inherited Create;
+  FSourceFile := ALineReader;
+end;
+
+constructor TJSScanner.Create(AStream: TStream);
+begin
+  FSourceStream:=ASTream;
+  FOwnSourceFile:=True;
+  Create(TStreamLineReader.Create(AStream));
+end;
+
+destructor TJSScanner.Destroy;
+begin
+  If FOwnSourceFile then
+    FSourceFile.Free;
+  inherited Destroy;
+end;
+
+procedure TJSScanner.OpenFile(const AFilename: string);
+begin
+  FSourceFile := TFileLineReader.Create(AFilename);
+  FSourceFilename := AFilename;
+end;
+
+Function TJSScanner.FetchRegexprToken: TJSToken;
+begin
+  if (CurToken in [tjsDiv,tjsDivEq]) then
+    Result:=ReadRegEx
+  else
+    Result:=CurToken
+end;
+
+
+procedure TJSScanner.Error(const Msg: string);
+begin
+  raise EJSScannerError.Create(Msg);
+end;
+
+procedure TJSScanner.Error(const Msg: string; Args: array of Const);
+begin
+  raise EJSScannerError.CreateFmt(Msg, Args);
+end;
+
+function TJSScanner.FetchLine: Boolean;
+begin
+  if FSourceFile.IsEOF then
+  begin
+    FCurLine := '';
+    TokenStr := nil;
+    Result := false;
+  end else
+  begin
+    FCurLine := FSourceFile.ReadLine;
+    TokenStr := PChar(CurLine);
+    Result := true;
+    Inc(FCurRow);
+    FWasEndofLine:=True;
+  end;
+end;
+
+function TJSScanner.DoWhiteSpace : TJSToken;
+
+begin
+  Result:=tjsWhitespace;
+  repeat
+    Inc(TokenStr);
+    if TokenStr[0] = #0 then
+      if not FetchLine then
+       begin
+       FCurToken := Result;
+       exit;
+       end;
+  until not (TokenStr[0] in [#9, ' ']);
+end;
+
+function TJSScanner.DoSingleLineComment : TJSToken;
+
+Var
+  TokenStart : PChar;
+  Len : Integer;
+
+begin
+  Inc(TokenStr);
+  TokenStart := TokenStr;
+  while TokenStr[0] <> #0 do
+     Inc(TokenStr);
+  Len:=TokenStr-TokenStart;
+  SetLength(FCurTokenString, Len);
+  if (Len>0) then
+    Move(TokenStart^,FCurTokenString[1],Len);
+  Result := tjsComment;
+end;
+
+function TJSScanner.DoMultiLineComment : TJSToken;
+
+Var
+  TokenStart : PChar;
+  Len,OLen : Integer;
+  PrevToken : Char;
+
+begin
+  Inc(TokenStr);
+  TokenStart := TokenStr;
+  FCurTokenString := '';
+  OLen:= 0;
+  PrevToken:=#0;
+  while Not ((TokenStr[0]='/') and (PrevToken='*')) do
+    begin
+    if (TokenStr[0]=#0) then
+      begin
+      Len:=TokenStr-TokenStart+1;
+      SetLength(FCurTokenString,OLen+Len);
+      if Len>1 then
+        Move(TokenStart^,FCurTokenString[OLen+1],Len-1);
+      Inc(OLen,Len);
+      FCurTokenString[OLen]:=#10;
+      if not FetchLine then
+        begin
+        Result := tjsEOF;
+        FCurToken := Result;
+        exit;
+        end;
+      TokenStart := TokenStr;
+      PrevToken:=#0;
+      end
+    else
+      begin
+      PrevToken:=TokenStr[0];
+      Inc(TokenStr);
+      end;
+    end;
+  Len:=TokenStr-TokenStart-1; // -1 for *
+  SetLength(FCurTokenString, Olen+Len);
+  if (Len>0) then
+    Move(TokenStart^, FCurTokenString[Olen + 1], Len);
+  Inc(TokenStr);
+  Result := tjsComment;
+end;
+
+function TJSScanner.CommentDiv : TJSToken;
+
+begin
+  FCurTokenString := '';
+  Inc(TokenStr);
+  if (TokenStr[0] = '/') then       // Single-line comment
+    Result:=DoSingleLineComment
+  else if (TokenStr[0]='*') then
+    Result:=DoMultiLineComment
+  else if (TokenStr[0] = '=') then       // Single-line comment
+    begin
+    Result:=tjsDiveQ;
+    Inc(TokenStr)
+    end
+  else
+    Result:=tjsDiv;
+end;
+
+function TJSScanner.ReadUnicodeEscape: WideChar;
+
+Var
+  S : String;
+  I : Integer;
+
+begin
+  S:='0000';
+  For I:=1 to 4 do
+    begin
+    Inc(TokenStr);
+    Case TokenStr[0] of
+      '0'..'9','A'..'F','a'..'f' :
+        S[i]:=Upcase(TokenStr[0]);
+    else
+      Error(SErrInvalidCharacter, [TokenStr[0]]);
+    end;
+    end;
+  // Takes care of conversion... This needs improvement !!
+  Result:=WideChar(StrToInt('$'+S));
+end;
+
+Function TJSScanner.ReadRegex: TJSToken;
+
+Var
+  CC : Boolean; // Character class
+  Done : Boolean;
+  CL,L : Integer;
+  TokenStart : PChar;
+
+begin
+  if (CurToken<>tjsDivEq) then
+    FCurTokenString := '/'
+  else
+    FCurTokenString := '/=';
+  CL:=Length(FCurTokenString);
+  Inc(TokenStr);
+  TokenStart:=TokenStr;
+  Done:=False;
+  CC:=False;
+  While Not Done do
+    begin
+    Case TokenStr[0] of
+      #0 : Done:=True;
+      '/' : Done:=Not CC;
+      '\' : begin
+            Inc(TokenStr);
+            Done:=TokenStr=#0;
+            end;
+      '[' : CC:=True;
+      ']' : CC:=False;
+    end;
+    if not Done then
+      Inc(TokenStr);
+    end;
+  If (TokenStr[0]<>'/') then
+    Error(SErrInvalidRegularExpression, [TokenStr[0]]);
+  repeat
+    Inc(TokenStr);
+  until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_','$']);
+  L:=(TokenStr-TokenStart);
+  SetLength(FCurTokenString,CL+L);
+  Move(TokenStart^,FCurTokenString[CL+1],L);
+  Result:=tjsRegEx;
+end;
+
+function TJSScanner.DoStringLiteral: TJSToken;
+
+Var
+  Delim : Char;
+  TokenStart : PChar;
+  Len,OLen: Integer;
+  S : String;
+
+begin
+  Delim:=TokenStr[0];
+  Inc(TokenStr);
+  TokenStart := TokenStr;
+  OLen := 0;
+  FCurTokenString := '';
+  while not (TokenStr[0] in [#0,Delim]) do
+    begin
+    if (TokenStr[0]='\') then
+      begin
+      // Save length
+      Len := TokenStr - TokenStart;
+      Inc(TokenStr);
+      // Read escaped token
+      Case TokenStr[0] of
+        '"' : S:='"';
+        '''' : S:='''';
+        't' : S:=#9;
+        'b' : S:=#8;
+        'n' : S:=#10;
+        'r' : S:=#13;
+        'f' : S:=#12;
+        '\' : S:='\';
+        '/' : S:='/';
+        'u' : begin
+              S:=ReadUniCodeEscape;
+              end;
+        #0  : Error(SErrOpenString);
+      else
+        Error(SErrInvalidCharacter, [TokenStr[0]]);
+      end;
+      SetLength(FCurTokenString, OLen + Len+1+Length(S));
+      if Len > 0 then
+        Move(TokenStart^, FCurTokenString[OLen + 1], Len);
+      Move(S[1],FCurTokenString[OLen + Len+1],Length(S));
+      Inc(OLen, Len+Length(S));
+      // Next char
+      // Inc(TokenStr);
+      TokenStart := TokenStr+1;
+      end;
+    if TokenStr[0] = #0 then
+      Error(SErrOpenString);
+    Inc(TokenStr);
+    end;
+  if TokenStr[0] = #0 then
+    Error(SErrOpenString);
+  Len := TokenStr - TokenStart;
+  SetLength(FCurTokenString, OLen + Len);
+  if Len > 0 then
+    Move(TokenStart^, FCurTokenString[OLen+1], Len);
+  Inc(TokenStr);
+  Result := tjsString;
+end;
+
+function TJSScanner.DoNumericLiteral :TJSToken;
+
+Var
+  TokenStart : PChar;
+  Len : Integer;
+
+begin
+  TokenStart := TokenStr;
+  while true do
+    begin
+    Inc(TokenStr);
+    case TokenStr[0] of
+      'x':
+        If (TokenStart[0]='0') and ((TokenStr-TokenStart)=1) then
+          begin
+          Inc(TokenStr);
+          while Upcase(TokenStr[0]) in ['0'..'9','A'..'F'] do
+            Inc(TokenStr);
+          end
+        else
+          Error(SInvalidHexadecimalNumber);
+      '.':
+        begin
+          if TokenStr[1] in ['0'..'9', 'e', 'E'] then
+          begin
+            Inc(TokenStr);
+            repeat
+              Inc(TokenStr);
+            until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
+          end;
+          break;
+        end;
+      '0'..'9': ;
+      'e', 'E':
+        begin
+          Inc(TokenStr);
+          if TokenStr[0] in ['-','+']  then
+            Inc(TokenStr);
+          while TokenStr[0] in ['0'..'9'] do
+            Inc(TokenStr);
+          break;
+        end;
+      else
+        break;
+    end;
+  end;
+  Len:=TokenStr-TokenStart;
+  Setlength(FCurTokenString, Len);
+  if (Len>0) then
+  Move(TokenStart^,FCurTokenString[1],Len);
+  Result := tjsNumber;
+end;
+
+function TJSScanner.DoIdentifier : TJSToken;
+
+Var
+  TokenStart:PChar;
+  Len : Integer;
+  I : TJSToken;
+
+begin
+  Result:=tjsIdentifier;
+  TokenStart := TokenStr;
+  repeat
+    Inc(TokenStr);
+    //If (TokenStr[0]='\') and (TokenStr[1]='u') then
+  until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_','$']);
+  Len:=(TokenStr-TokenStart);
+  SetLength(FCurTokenString,Len);
+  if Len > 0 then
+    Move(TokenStart^,FCurTokenString[1],Len);
+  // Check if this is a keyword or identifier
+  // !!!: Optimize this!
+  for i:=FirstKeyword to Lastkeyword do
+    if CurTokenString=TokenInfos[i] then
+      begin
+      Result := i;
+      FCurToken := Result;
+      exit;
+      end;
+end;
+
+Function TJSScanner.FetchToken: TJSToken;
+
+begin
+  if not (FCurtoken in [tjsWhiteSpace,tjsComment]) then
+    FWasEndOfLine:=False;
+  Repeat
+    if TokenStr = nil then
+      begin
+      if not FetchLine then
+        begin
+        Result := tjsEOF;
+        FCurToken := Result;
+        exit;
+        end;
+      end;
+    //CurPos:=TokenStr;
+    FCurTokenString := '';
+    case TokenStr[0] of
+      #0:         // Empty line
+        begin
+        FetchLine;
+        Result := tjsWhitespace;
+        end;
+      '/' :
+         Result:=CommentDiv;
+      #9, ' ':
+         Result := DoWhiteSpace;
+      '''','"':
+         Result:=DoStringLiteral;
+      '0'..'9':
+         Result:=DoNumericLiteral;
+     '&':
+         begin
+         Inc(TokenStr);
+         If Tokenstr[0]='&' then
+           begin
+           Inc(TokenStr);
+           Result := tjsAndAnd;
+           end
+         else If Tokenstr[0]='=' then
+           begin
+           Inc(TokenStr);
+           Result := tjsAndEQ;
+           end
+         else
+           Result := tjsAnd;
+         end;
+     '%':
+         begin
+         Inc(TokenStr);
+         If Tokenstr[0]='=' then
+           begin
+           Inc(TokenStr);
+           Result := tjsModEq;
+           end
+         else
+           Result := tjsMod;
+         end;
+     '^':
+         begin
+         Inc(TokenStr);
+         If (TokenStr[0]='=') then
+           begin
+           Result:=tjsXorEq;
+           Inc(tokenStr)
+           end
+         else
+           result:=tjsXOR;
+         end;
+     '|':
+         begin
+         Inc(TokenStr);
+         If Tokenstr[0]='|' then
+           begin
+           Inc(TokenStr);
+           Result := tjsOROR;
+           end
+         else If Tokenstr[0]='=' then
+             begin
+             Inc(TokenStr);
+             Result := tjsOREQ;
+             end
+         else
+           Result := tjsOR;
+         end;
+    '(':
+      begin
+      Inc(TokenStr);
+      Result := tjsBraceOpen;
+      end;
+    ')':
+      begin
+      Inc(TokenStr);
+      Result := tjsBraceClose;
+      end;
+    '*':
+      begin
+      Inc(TokenStr);
+      If (TokenStr[0]='=') then
+        begin
+        Inc(TokenStr);
+        Result := tjsMulEq;
+        end
+      else
+        Result := tjsMul;
+      end;
+    '+':
+      begin
+      Inc(TokenStr);
+      If (TokenStr[0]='=') then
+        begin
+        Inc(TokenStr);
+        Result := tjsPlusEq;
+        end
+      else If (TokenStr[0]='+') then
+        begin
+        Inc(TokenStr);
+        Result := tjsPlusPlus;
+        end
+      else
+        Result := tjsPlus;
+      end;
+    ',':
+      begin
+        Inc(TokenStr);
+        Result := tjsComma;
+      end;
+    '-':
+      begin
+      Inc(TokenStr);
+      If (TokenStr[0]='=') then
+        begin
+        Inc(TokenStr);
+        Result:=tjsMinusEq
+        end
+      else If (TokenStr[0]='-') then
+        begin
+        Inc(TokenStr);
+        Result:=tjsMinusMinus
+        end
+      else if (TokenStr[0] in ['0'..'9']) then
+        begin
+        Result:=DoNumericLiteral;
+        If (Result=tjsNumber) then
+          FCurTokenString:='-'+FCurTokenString;
+        end
+      else
+        Result := tjsMinus;
+      end;
+    '.':
+      begin
+      Inc(TokenStr);
+      if (TokenStr[0] in ['0'..'9']) then
+        begin
+        Result:=DoNumericLiteral;
+        If (Result=tjsNumber) then
+          FCurTokenString:='0.'+FCurTokenString;
+         end
+      else
+        Result := tjsDot;
+      end;
+    ':':
+      begin
+      Inc(TokenStr);
+      Result := tjsColon;
+      end;
+    '?':
+      begin
+      Inc(TokenStr);
+      Result := tjsConditional;
+      end;
+    ';':
+      begin
+      Inc(TokenStr);
+      Result := tjsSemicolon;
+      end;
+    '<':
+      begin
+      Inc(TokenStr);
+      if TokenStr[0] = '=' then
+        begin
+        Inc(TokenStr);
+        Result := tjsLE;
+        end
+      else if TokenStr[0] = '<' then
+        begin
+        Inc(TokenStr);
+        if (TokenStr[0] = '=') then
+          begin
+          Inc(TokenStr);
+          Result := tjsLShiftEq;
+          end
+        else
+          Result := tjsLShift;
+        end
+      else
+        Result := tjsLT;
+      end;
+    '=':
+      begin
+      Inc(TokenStr);
+      if (TokenStr[0]='=') then
+        begin
+        Inc(TokenStr);
+        If (TokenStr[0]='=') then
+          begin
+          Inc(TokenStr);
+          Result:=tjsSEQ;
+          end
+        else
+          Result:=tjsEQ;
+        end
+      else
+        Result := tjsAssign;
+      end;
+    '!':
+      begin
+      Inc(TokenStr);
+      if (TokenStr[0]='=') then
+        begin
+        Inc(TokenStr);
+        If (TokenStr[0]='=') then
+          begin
+          Inc(TokenStr);
+          Result:=tjsSNE;
+          end
+        else
+          Result:=tjsNE;
+        end
+      else
+        Result:=tjsNot;// Error(SErrInvalidNonEqual);
+      end;
+    '~':
+      begin
+      Inc(TokenStr);
+      Result:=tjsInv;
+      end;
+    '>':
+      begin
+      Inc(TokenStr);
+      if TokenStr[0] = '=' then
+	begin
+        Inc(TokenStr);
+        Result:=tjsGE;
+        end
+      else if TokenStr[0] = '>' then
+  	begin
+        Inc(TokenStr);
+        if (TokenStr[0] = '>') then
+       	  begin
+          Inc(TokenStr);
+          if (TokenStr[0] = '=') then
+            begin
+            Inc(TokenStr);
+            Result:=tjsURSHIFTEQ;
+            end
+          else
+            Result:=tjsURSHIFT;
+          end
+        else if (TokenStr[0] = '=') then
+          begin
+          Inc(TokenStr);
+          Result:=tjsRSHIFTEq;
+          end
+        else
+          Result:=tjsRSHIFT;
+        end
+      else
+        Result := tjsGT;
+      end;
+    '[':
+      begin
+      Inc(TokenStr);
+      Result := tJSSquaredBraceOpen;
+      end;
+    ']':
+      begin
+      Inc(TokenStr);
+      Result := tJSSquaredBraceClose;
+      end;
+    '{':
+      begin
+      Inc(TokenStr);
+      Result := tJSCurlyBraceOpen;
+      end;
+    '}':
+      begin
+      Inc(TokenStr);
+      Result := tJSCurlyBraceClose;
+      end;
+   else
+     Result:=DoIdentifier;
+   end; // Case
+  Until (Not (Result in [tjsComment,tjsWhitespace])) or
+        ((Result=tjsComment) and ReturnComments) or
+        ((Result=tjsWhiteSpace) and ReturnWhiteSpace);
+end;
+
+Function TJSScanner.IsEndOfLine: Boolean;
+begin
+  Result:=(TokenStr=Nil) or (TokenStr[0] in [#0,#10,#13]);
+end;
+
+function TJSScanner.GetCurColumn: Integer;
+begin
+  Result := TokenStr - PChar(CurLine);
+end;
+
+{ TStreamLineReader }
+
+constructor TStreamLineReader.Create(AStream: TStream);
+begin
+  FStream:=AStream;
+  FBufPos:=0;
+  FBufLen:=0;
+end;
+
+function TStreamLineReader.IsEOF: Boolean;
+begin
+  Result:=(FBufPos>=FBufLen);
+  If Result then
+    begin
+    FillBuffer;
+    Result:=(FBufLen=0);
+    end;
+end;
+
+procedure TStreamLineReader.FillBuffer;
+
+begin
+  FBufLen:=FStream.Read(Buffer,SizeOf(Buffer)-1);
+  Buffer[FBufLen]:=0;
+  FBufPos:=0;
+end;
+
+function TStreamLineReader.ReadLine: string;
+
+Var
+  FPos,OLen,Len: Integer;
+  PRun : PByte;
+
+begin
+  FPos:=FBufPos;
+  SetLength(Result,0);
+  Repeat
+    PRun:=@Buffer[FBufPos];
+    While (FBufPos<FBufLen) and Not (PRun^ in [10,13]) do
+      begin
+      Inc(PRun);
+      Inc(FBufPos);
+      end;
+    If (FBufPos=FBufLen) then
+      begin
+      Len:=FBufPos-FPos;
+      If (Len>0) then
+        begin
+        Olen:=Length(Result);
+        SetLength(Result,OLen+Len);
+        Move(Buffer[FPos],Result[OLen+1],Len);
+        end;
+      FillBuffer;
+      FPos:=FBufPos;
+      end;
+  until (FBufPos=FBufLen) or (PRun^ in [10,13]);
+  Len:=FBufPos-FPos;
+  If (Len>0) then
+    begin
+    Olen:=Length(Result);
+    SetLength(Result,OLen+Len);
+    Move(Buffer[FPos],Result[OLen+1],Len)
+    end;
+  If (PRun^ in [10,13]) and (FBufPos<FBufLen) then
+    begin
+    Inc(FBufPos);
+    // Check #13#10
+    If (PRun^=13) then
+      begin
+      If (FBufPos=FBufLen) then
+        FillBuffer;
+      If (FBufPos<FBufLen) and (Buffer[FBufpos]=10) then
+        Inc(FBufPos);
+      end;
+    end;
+end;
+
+end.

+ 1252 - 0
compiler/packages/fcl-js/src/jssrcmap.pas

@@ -0,0 +1,1252 @@
+{ *********************************************************************
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018 Mattias Gaertner.
+
+    Javascript Source Map
+
+    See Source Maps Revision 3:
+    https://docs.google.com/document/d/1U1RGAehQwRypUTovF1KRlpiOFze0b-_2gc6fAH0KY0k/edit?hl=en_US&pli=1&pli=1#
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+  **********************************************************************}
+unit JSSrcMap;
+
+{$mode objfpc}{$H+}
+
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define HasJsonParser}
+  {$define HasStreams}
+  {$define HasFS}
+{$endif}
+
+{$ifdef pas2js}
+  {$ifdef nodejs}
+    {$define HasFS}
+  {$endif}
+{$endif}
+
+interface
+
+uses
+  {$ifdef pas2js}
+  JS,
+    {$ifdef nodejs}
+    NodeJSFS,
+    {$endif}
+  {$else}
+  contnrs,
+  {$endif}
+  Classes, SysUtils, fpjson
+  {$ifdef HasJsonParser}
+  , jsonparser, jsonscanner
+  {$endif}
+  ;
+
+const
+  Base64Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+
+type
+  EJSSourceMap = class(Exception);
+
+  { TSourceMapSegment }
+
+  TSourceMapSegment = class
+  public
+    Index: integer; // index in Items
+    GeneratedLine: integer; // 1-based
+    GeneratedColumn: integer; // 0-based
+    SrcFileIndex: integer; // index in FSources
+    SrcLine: integer;
+    SrcColumn: integer;
+    NameIndex: integer; // index in FNames
+  end;
+
+  TSourceMapSrc = class
+  public
+    Filename: string; // as added by AddMapping
+    TranslatedFilename: string; // same as Filename, can be altered, written to JSON
+    Source: String;
+  end;
+
+  TSourceMapOption = (
+    smoAddMonotonous, // true = AddMapping GeneratedLine/Col must be behind last add, false = check all adds for duplicate
+    smoAutoLineStart, // automatically add a first column mapping, repeating last mapping
+    smoSafetyHeader, // insert ')]}' at start
+    smoAllowSrcLine0 // don't bark on SrcLine=0
+    );
+  TSourceMapOptions = set of TSourceMapOption;
+const
+  DefaultSourceMapOptions = [smoAddMonotonous,smoSafetyHeader];
+type
+
+  { TSourceMap }
+
+  TSourceMap = class
+  private
+    type
+
+      { TStringToIndex }
+
+      TStringToIndex = class
+      private
+        FItems: {$ifdef pas2js}TJSObject{$else}TFPHashList{$endif};
+      public
+        constructor Create;
+        destructor Destroy; override;
+        procedure Clear;
+        procedure Add(const Value: String; Index: integer);
+        function FindValue(const Value: String): integer;
+      end;
+  private
+    FGeneratedFilename: string;
+    FNames: TStrings; // in adding order
+    FNameToIndex: TStringToIndex; // name to index in FNames
+    FItems: TFPList; // TSourceMapSegment, in adding order
+    FOptions: TSourceMapOptions;
+    FSorted: boolean;
+    FSourceRoot: string;
+    FSources: TFPList; // list of TSourceMapSrc, in adding order
+    FSourceToIndex: TStringToIndex; // srcfile to index in FSources
+    FVersion: integer;
+    function GetNames(Index: integer): string;
+    function GetItems(Index: integer): TSourceMapSegment;
+    function GetSourceContents(Index: integer): String;
+    function GetSourceFiles(Index: integer): String;
+    function GetSourceTranslatedFiles(Index: integer): String;
+    procedure SetGeneratedFilename(const AValue: string);
+    procedure SetSorted(const AValue: boolean);
+    procedure SetSourceContents(Index: integer; const AValue: String);
+    procedure SetSourceTranslatedFiles(Index: integer; const AValue: String);
+    procedure Sort;
+  public
+    constructor Create(const aGeneratedFilename: string);
+    destructor Destroy; override;
+    procedure Clear; virtual;
+    function AddMapping(
+      GeneratedLine: integer; // 1-based
+      GeneratedCol: integer = 0; // 0-based
+      const SourceFile: string = ''; // can be empty ''
+      SrcLine: integer = 1; // 1-based
+      SrcCol: integer = 0; // 0-based
+      const Name: String = ''): TSourceMapSegment; virtual;
+    function CreateMappings: String; virtual;
+    procedure ParseMappings(const Mapping: String); virtual;
+    function ToJSON: TJSONObject; virtual;
+    function ToString: string; override;
+    procedure LoadFromJSON(Obj: TJSONObject); virtual;
+    procedure SaveToStream(aStream: TFPJSStream); virtual;
+    {$ifdef HasStreams}
+    procedure LoadFromStream(aStream: TStream); virtual;
+    procedure SaveToFile(Filename: string); virtual;
+    procedure LoadFromFile(Filename: string); virtual;
+    {$endif}
+    property GeneratedFilename: string read FGeneratedFilename write SetGeneratedFilename;
+    function IndexOfName(const Name: string; AddIfNotExists: boolean = false): integer;
+    function IndexOfSourceFile(const SrcFile: string; AddIfNotExists: boolean = false): integer;
+    function IndexOfSegmentAt(GeneratedLine, GeneratedCol: integer): integer;
+    function Count: integer; // segments
+    property Items[Index: integer]: TSourceMapSegment read GetItems; default; // segments
+    function SourceCount: integer;
+    property SourceRoot: string read FSourceRoot write FSourceRoot;
+    property SourceFiles[Index: integer]: String read GetSourceFiles;
+    property SourceTranslatedFiles[Index: integer]: String read GetSourceTranslatedFiles
+      write SetSourceTranslatedFiles;
+    property SourceContents[Index: integer]: String read GetSourceContents write SetSourceContents;
+    function NameCount: integer;
+    property Names[Index: integer]: string read GetNames;
+    property Version: integer read FVersion; // 3
+    property Options: TSourceMapOptions read FOptions write FOptions;
+    property Sorted: boolean read FSorted write SetSorted; // Segments are sorted for GeneratedLine/Col
+  end;
+
+function DefaultSrcMapHeader: string;
+
+function EncodeBase64VLQ(i: NativeInt): String; // base64 Variable Length Quantity
+function DecodeBase64VLQ(const s: string): NativeInt; // base64 Variable Length Quantity
+function DecodeBase64VLQ(
+  {$ifdef UsePChar}var p: PChar{$else}const s: string; var p: integer{$endif}): NativeInt; // base64 Variable Length Quantity
+
+function CompareSegmentWithGeneratedLineCol(
+  Item1, Item2: {$ifdef pas2js}jsvalue{$else}Pointer{$endif}): Integer;
+
+procedure DebugSrcMapLine(GeneratedLine: integer; var GeneratedLineSrc: String;
+  SrcMap: TSourceMap; out InfoLine: String);
+
+implementation
+
+function DefaultSrcMapHeader: string;
+begin
+  Result:=')]}'''+LineEnding;
+end;
+
+function EncodeBase64VLQ(i: NativeInt): String;
+{ Convert signed number to base64-VLQ:
+  Each base64 has 6bit, where the most significant bit is the continuation bit
+  (1=there is a next base64 character).
+  The first character contains the sign bit in the last bit (1=negative)
+  and the 5 least significant bits of the number.
+  For example:
+  A = 0 = %000000 => 0
+  B = 1 = %000001 => -0
+  C = 2 = %000010 => 1
+  iF = 34 5 = %100010 %000101 = + 0001 00101 = 100101 = 37
+}
+
+  procedure RaiseRange;
+  begin
+    raise ERangeError.Create('EncodeBase64VLQ');
+  end;
+
+var
+  digits: NativeInt;
+begin
+  Result:='';
+  if i<0 then
+    begin
+    i:=-i;
+    if i>(High(NativeInt)-1) shr 1 then
+      RaiseRange;
+    i:=(i shl 1)+1;
+    end
+  else
+    begin
+    if i>High(NativeInt) shr 1 then
+      RaiseRange;
+    i:=i shl 1;
+    end;
+  repeat
+    digits:=i and %11111;
+    i:=i shr 5;
+    if i>0 then
+      inc(digits,%100000); // need another char -> set continuation bit
+    Result:=Result+Base64Chars[digits+1];
+  until i=0;
+end;
+
+function DecodeBase64VLQ(const s: string): NativeInt;
+var
+  {$ifdef UsePChar}
+  p: PChar;
+  {$else}
+  p: integer;
+  {$endif}
+begin
+  if s='' then
+    raise EConvertError.Create('DecodeBase64VLQ empty');
+  {$ifdef UsePChar}
+  p:=PChar(s);
+  Result:=DecodeBase64VLQ(p);
+  if p-PChar(s)<>length(s) then
+    raise EConvertError.Create('DecodeBase64VLQ waste');
+  {$else}
+  p:=1;
+  Result:=DecodeBase64VLQ(s,p);
+  {$endif}
+end;
+
+function DecodeBase64VLQ(
+  {$ifdef UsePChar}var p: PChar{$else}const s: string; var p: integer{$endif}): NativeInt;
+{ Convert base64-VLQ to signed number,
+  For the fomat see EncodeBase64VLQ
+}
+var
+  {$ifdef UsePChar}
+  run: PChar;
+  {$else}
+  run, l: integer;
+  {$endif}
+
+  procedure RaiseInvalid;
+  begin
+    p:=run;
+    raise ERangeError.Create('DecodeBase64VLQ');
+  end;
+
+const
+  MaxShift = {$ifdef pas2js}32{$else}63{$endif}-5; // actually log2(High(NativeInt))-5
+var
+  c: Char;
+  digit, Shift: Integer;
+begin
+  Result:=0;
+  Shift:=0;
+  run:=p;
+  {$ifdef UsePChar}
+  {$else}
+  l:=length(s);
+  {$endif}
+  repeat
+    {$ifdef UsePChar}
+    c:=run^;
+    {$else}
+    if run>l then
+      RaiseInvalid;
+    c:=s[run];
+    {$endif}
+    case c of
+    'A'..'Z': digit:=ord(c)-ord('A');
+    'a'..'z': digit:=ord(c)-ord('a')+26;
+    '0'..'9': digit:=ord(c)-ord('0')+52;
+    '+': digit:=62;
+    '/': digit:=63;
+    else RaiseInvalid;
+    end;
+    inc(run);
+    if Shift>MaxShift then
+      RaiseInvalid;
+    inc(Result,(digit and %11111) shl Shift);
+    inc(Shift,5);
+  until digit<%100000;
+  if (Result and 1)>0 then
+    Result:=-(Result shr 1)
+  else
+    Result:=Result shr 1;
+  p:=run;
+end;
+
+function CompareSegmentWithGeneratedLineCol(
+    Item1, Item2: {$ifdef pas2js}jsvalue{$else}Pointer{$endif}): Integer;
+var
+  Seg1: TSourceMapSegment absolute Item1;
+  Seg2: TSourceMapSegment absolute Item2;
+begin
+  if Seg1.GeneratedLine<Seg2.GeneratedLine then
+    Result:=-1
+  else if Seg1.GeneratedLine>Seg2.GeneratedLine then
+    Result:=1
+  else if Seg1.GeneratedColumn<Seg2.GeneratedColumn then
+    Result:=-1
+  else if Seg1.GeneratedColumn>Seg2.GeneratedColumn then
+    Result:=1
+  // compare Index to keep adding order
+  else if Seg1.Index<Seg2.Index then
+    Result:=-1
+  else if Seg1.Index>Seg2.Index then
+    Result:=1
+  else
+    Result:=0;
+end;
+
+procedure DebugSrcMapLine(GeneratedLine: integer; var GeneratedLineSrc: String;
+  SrcMap: TSourceMap; out InfoLine: String);
+var
+  JS, Origins, Addition: String;
+  GeneratedCol: integer; // 0-based
+  i, diff, GenColStep, LastSrcFile, LastSrcLine: Integer;
+  aSeg: TSourceMapSegment;
+begin
+  InfoLine:='';
+  JS:=GeneratedLineSrc;
+  Origins:='';
+  GeneratedCol:=0;// 0-based
+  LastSrcFile:=0;
+  LastSrcLine:=-1;
+  i:=SrcMap.IndexOfSegmentAt(GeneratedLine,GeneratedCol);
+  aSeg:=nil;
+  if i<0 then
+    begin
+    // no segment at line start
+    i:=0;
+    if (i=SrcMap.Count) then
+      aSeg:=nil
+    else
+      aSeg:=SrcMap[i];
+    if (aSeg=nil) or (aSeg.GeneratedLine>GeneratedLine) then
+      begin
+      // no segment in line
+      for i:=1 to length(JS) do Origins:=Origins+'?';
+      GeneratedLineSrc:=JS;
+      InfoLine:=Origins;
+      exit;
+      end
+    else
+      begin
+      // show "?" til start of first segment
+      for i:=1 to aSeg.GeneratedColumn do Origins:=Origins+'?';
+      end;
+    end
+  else
+    begin
+    aSeg:=SrcMap[i];
+    if i>0 then
+      LastSrcFile:=SrcMap[i-1].SrcFileIndex;
+    end;
+
+  repeat
+    Addition:='';
+    if (aSeg.GeneratedLine=GeneratedLine) and (aSeg.GeneratedColumn=GeneratedCol) then
+      begin
+      // segment starts here  -> write "|line,col"
+      Addition:='|';
+      if LastSrcFile<>aSeg.SrcFileIndex then
+        begin
+        Addition:=Addition+{$ifdef HasFS}ExtractFileName{$endif}(SrcMap.SourceFiles[aSeg.SrcFileIndex])+',';
+        LastSrcFile:=aSeg.SrcFileIndex;
+        end;
+      if LastSrcLine<>aSeg.SrcLine then
+        begin
+        Addition:=Addition+IntToStr(aSeg.SrcLine)+',';
+        LastSrcLine:=aSeg.SrcLine;
+        end;
+      Addition:=Addition+IntToStr(aSeg.SrcColumn);
+      Origins:=Origins+Addition;
+      end;
+    inc(i);
+    // skip segments at same GeneratedLine/Col
+    while (i<SrcMap.Count) do
+      begin
+      aSeg:=SrcMap[i];
+      if (aSeg.GeneratedLine=GeneratedLine) and (aSeg.GeneratedColumn=GeneratedCol) then
+        inc(i)
+      else
+        break;
+      end;
+    if (i=SrcMap.Count) then
+      aSeg:=nil
+    else
+      aSeg:=SrcMap[i];
+    if (aSeg=nil) or (aSeg.GeneratedLine>GeneratedLine) then
+      begin
+      // in the last segment
+      while length(Origins)<length(JS) do
+        Origins:=Origins+'.';
+      GeneratedLineSrc:=JS;
+      InfoLine:=Origins;
+      exit;
+      end;
+    // there is another segment in this line
+    // -> align JS and Origins
+    GenColStep:=aSeg.GeneratedColumn-GeneratedCol;
+    diff:=GenColStep-length(Addition);
+    if diff<0 then
+      // for example:
+      //  JS:       if(~~e)~~~{
+      //  Origins:  |12,3|12,5|12,7
+      Insert(StringOfChar('~',-diff),JS,length(Origins)-length(Addition)+1+GenColStep)
+    else
+      while diff>0 do
+        begin
+        Origins:=Origins+'.';
+        dec(diff);
+        end;
+    GeneratedCol:=aSeg.GeneratedColumn;
+  until false;
+end;
+
+{ TSourceMap.TStringToIndex }
+
+constructor TSourceMap.TStringToIndex.Create;
+begin
+  {$ifdef pas2js}
+  FItems:=TJSObject.new;
+  {$else}
+  FItems:=TFPHashList.Create;
+  {$endif}
+end;
+
+destructor TSourceMap.TStringToIndex.Destroy;
+begin
+  {$ifdef pas2js}
+  FItems:=nil;
+  {$else}
+  FItems.Clear;
+  FreeAndNil(FItems);
+  {$endif}
+  inherited Destroy;
+end;
+
+procedure TSourceMap.TStringToIndex.Clear;
+begin
+  {$ifdef pas2js}
+  FItems:=TJSObject.new;
+  {$else}
+  FItems.Clear;
+  {$endif}
+end;
+
+procedure TSourceMap.TStringToIndex.Add(const Value: String; Index: integer);
+begin
+  {$ifdef pas2js}
+  FItems['%'+Value]:=Index;
+  {$else}
+  // Note: nil=0 means not found in TFPHashList
+  FItems.Add(Value,{%H-}Pointer(PtrInt(Index+1)));
+  {$endif}
+end;
+
+function TSourceMap.TStringToIndex.FindValue(const Value: String
+  ): integer;
+begin
+  {$ifdef pas2js}
+  if FItems.hasOwnProperty('%'+Value) then
+    Result:=integer(FItems['%'+Value])
+  else
+    Result:=-1;
+  {$else}
+  // Note: nil=0 means not found in TFPHashList
+  Result:=integer({%H-}PtrInt(FItems.Find(Value))){%H-}-1;
+  {$endif}
+end;
+
+{ TSourceMap }
+
+procedure TSourceMap.SetGeneratedFilename(const AValue: string);
+begin
+  if FGeneratedFilename=AValue then Exit;
+  FGeneratedFilename:=AValue;
+end;
+
+procedure TSourceMap.SetSorted(const AValue: boolean);
+begin
+  if FSorted=AValue then Exit;
+  if AValue then
+    Sort
+  else
+    FSorted:=false;
+end;
+
+procedure TSourceMap.SetSourceContents(Index: integer; const AValue: String);
+begin
+  TSourceMapSrc(FSources[Index]).Source:=AValue;
+end;
+
+procedure TSourceMap.SetSourceTranslatedFiles(Index: integer;
+  const AValue: String);
+begin
+  TSourceMapSrc(FSources[Index]).TranslatedFilename:=AValue;
+end;
+
+procedure TSourceMap.Sort;
+var
+  i: Integer;
+begin
+  if FSorted then exit;
+  FItems.Sort(@CompareSegmentWithGeneratedLineCol);
+  for i:=0 to Count-1 do
+    Items[i].Index:=i;
+  FSorted:=true;
+end;
+
+function TSourceMap.GetItems(Index: integer): TSourceMapSegment;
+begin
+  Result:=TSourceMapSegment(FItems[Index]);
+end;
+
+function TSourceMap.GetSourceContents(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Source;
+end;
+
+function TSourceMap.GetNames(Index: integer): string;
+begin
+  Result:=FNames[Index];
+end;
+
+function TSourceMap.GetSourceFiles(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Filename;
+end;
+
+function TSourceMap.GetSourceTranslatedFiles(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).TranslatedFilename;
+end;
+
+constructor TSourceMap.Create(const aGeneratedFilename: string);
+begin
+  FOptions:=DefaultSourceMapOptions;
+  FVersion:=3;
+  FNames:=TStringList.Create;
+  FNameToIndex:=TStringToIndex.Create;
+  FItems:=TFPList.Create;
+  FSources:=TFPList.Create;
+  FSourceToIndex:=TStringToIndex.Create;
+  GeneratedFilename:=aGeneratedFilename;
+  FSorted:=true;
+end;
+
+destructor TSourceMap.Destroy;
+begin
+  Clear;
+  FreeAndNil(FSourceToIndex);
+  FreeAndNil(FSources);
+  FreeAndNil(FItems);
+  FreeAndNil(FNameToIndex);
+  FreeAndNil(FNames);
+  inherited Destroy;
+end;
+
+procedure TSourceMap.Clear;
+var
+  i: Integer;
+begin
+  FGeneratedFilename:='';
+  FSourceToIndex.Clear;
+  for i:=0 to FSources.Count-1 do
+    TObject(FSources[i]).{$ifdef pas2js}Destroy{$else}Free{$endif};
+  FSources.Clear;
+  for i:=0 to FItems.Count-1 do
+    TObject(FItems[i]).{$ifdef pas2js}Destroy{$else}Free{$endif};
+  FItems.Clear;
+  FNameToIndex.Clear;
+  FNames.Clear;
+  FSourceRoot:='';
+  FSorted:=true;
+end;
+
+function TSourceMap.AddMapping(GeneratedLine: integer; GeneratedCol: integer;
+  const SourceFile: string; SrcLine: integer; SrcCol: integer;
+  const Name: String): TSourceMapSegment;
+
+  procedure RaiseInvalid(Msg: string);
+  begin
+    raise EJSSourceMap.CreateFmt('%s (GeneratedLine=%d GeneratedCol=%d SrcFile="%s" SrcLine=%d SrcCol=%d Name="%s")',
+      [Msg,GeneratedLine,GeneratedCol,SourceFile,SrcLine,SrcCol,Name]);
+  end;
+
+var
+  NodeCnt: Integer;
+  OtherNode: TSourceMapSegment;
+begin
+  {$IFDEF VerboseSrcMap}
+  writeln('TSourceMap.AddMapping Gen:Line=',GeneratedLine,',Col=',GeneratedCol,
+    ' Src:File=',ExtractFileName(SourceFile),',Line=',SrcLine,',Col=',SrcCol,' Name=',Name);
+  {$ENDIF}
+  if GeneratedLine<1 then
+    RaiseInvalid('invalid GeneratedLine');
+  if GeneratedCol<0 then
+    RaiseInvalid('invalid GeneratedCol');
+  if SourceFile='' then
+    begin
+    if Count=0 then
+      RaiseInvalid('missing source file');
+    if SrcLine<>1 then
+      RaiseInvalid('invalid SrcLine');
+    if SrcCol<>0 then
+      RaiseInvalid('invalid SrcCol');
+    if Name<>'' then
+      RaiseInvalid('invalid Name');
+    end
+  else
+    begin
+    if SrcLine<1 then
+    begin
+      if (SrcLine<0) or not (smoAllowSrcLine0 in Options) then
+        RaiseInvalid('invalid SrcLine');
+    end;
+    if SrcCol<0 then
+      RaiseInvalid('invalid SrcCol');
+    end;
+
+  // Note: same line/col is allowed
+  NodeCnt:=Count;
+  if (NodeCnt>0) then
+    begin
+    OtherNode:=Items[NodeCnt-1];
+    if (OtherNode.GeneratedLine>GeneratedLine)
+        or ((OtherNode.GeneratedLine=GeneratedLine)
+          and (OtherNode.GeneratedColumn>GeneratedCol)) then
+      begin
+      if smoAddMonotonous in FOptions then
+        RaiseInvalid('GeneratedLine/Col not monotonous')
+      else
+        FSorted:=false;
+      end;
+    end;
+
+  // add
+  Result:=TSourceMapSegment.Create;
+  Result.Index:=FItems.Count;
+  Result.GeneratedLine:=GeneratedLine;
+  Result.GeneratedColumn:=GeneratedCol;
+  if SourceFile='' then
+    Result.SrcFileIndex:=-1
+  else
+    Result.SrcFileIndex:=IndexOfSourceFile(SourceFile,true);
+  Result.SrcLine:=SrcLine;
+  Result.SrcColumn:=SrcCol;
+  if Name<>'' then
+    Result.NameIndex:=IndexOfName(Name,true)
+  else
+    Result.NameIndex:=-1;
+  FItems.Add(Result);
+end;
+
+function TSourceMap.CreateMappings: String;
+
+{$ifdef pas2js}
+var
+  buf: TJSArray;
+
+  procedure AddStr(const s: string); inline;
+  begin
+    buf.push(s);
+  end;
+
+  procedure AddChar(c: char); inline;
+  begin
+    buf.push(c);
+  end;
+{$else}
+var
+  buf: TMemoryStream;
+
+  procedure AddStr(const s: string);
+  begin
+    if s<>'' then
+      buf.Write(s[1],length(s)*sizeof(char));
+  end;
+
+  procedure AddChar(c: char);
+  begin
+    buf.Write(c,sizeof(char));
+  end;
+{$endif}
+
+var
+  i, LastGeneratedLine, LastGeneratedColumn, j, LastSrcFileIndex, LastSrcLine,
+    LastSrcColumn, SrcLine, LastNameIndex: Integer;
+  Item: TSourceMapSegment;
+begin
+  Result:='';
+  LastGeneratedLine:=1;
+  LastGeneratedColumn:=0;
+  LastSrcFileIndex:=0;
+  LastSrcLine:=0;
+  LastSrcColumn:=0;
+  LastNameIndex:=0;
+  {$ifdef pas2js}
+  buf:=TJSArray.new;
+  {$else}
+  buf:=TMemoryStream.Create;
+  {$endif}
+  try
+    for i:=0 to Count-1 do
+      begin
+      Item:=Items[i];
+      if LastGeneratedLine<Item.GeneratedLine then
+        begin
+        // new line
+        //LastGeneratedColumn:=0;
+        for j:=LastGeneratedLine+1 to Item.GeneratedLine do
+          begin
+          AddChar(';');
+          if (smoAutoLineStart in FOptions)
+              and ((j<Item.GeneratedLine) or (Item.GeneratedColumn>0)) then
+            begin
+            // repeat mapping at start of line
+            // column 0
+            AddStr(EncodeBase64VLQ(0-LastGeneratedColumn));
+            LastGeneratedColumn:=0;
+            // same src file index
+            AddStr(EncodeBase64VLQ(0));
+            // same src line
+            AddStr(EncodeBase64VLQ(0));
+            // same src column
+            AddStr(EncodeBase64VLQ(0));
+            if j=Item.GeneratedLine then
+              AddChar(',');
+            end;
+          end;
+        LastGeneratedLine:=Item.GeneratedLine;
+        end
+      else if i>0 then
+        begin
+        // not the first segment
+        if (LastGeneratedLine=Item.GeneratedLine)
+            and (LastGeneratedColumn=Item.GeneratedColumn) then
+          continue;
+        AddChar(',');
+        end;
+      // column diff
+      //writeln('TSourceMap.CreateMappings Seg=',i,' Gen:Line=',LastGeneratedLine,',Col=',Item.GeneratedColumn,' Src:File=',Item.SrcFileIndex,',Line=',Item.SrcLine,',Col=',Item.SrcColumn,' Name=',Item.NameIndex);
+      AddStr(EncodeBase64VLQ(Item.GeneratedColumn-LastGeneratedColumn));
+      LastGeneratedColumn:=Item.GeneratedColumn;
+
+      if Item.SrcFileIndex<0 then
+        continue; // no source -> segment length 1
+      // src file index diff
+      AddStr(EncodeBase64VLQ(Item.SrcFileIndex-LastSrcFileIndex));
+      LastSrcFileIndex:=Item.SrcFileIndex;
+      // src line diff
+      SrcLine:=Item.SrcLine-1; // 0 based in version 3
+      AddStr(EncodeBase64VLQ(SrcLine-LastSrcLine));
+      LastSrcLine:=SrcLine;
+      // src column diff
+      AddStr(EncodeBase64VLQ(Item.SrcColumn-LastSrcColumn));
+      LastSrcColumn:=Item.SrcColumn;
+      // name index
+      if Item.NameIndex<0 then
+        continue; // no name -> segment length 4
+      AddStr(EncodeBase64VLQ(Item.NameIndex-LastNameIndex));
+      LastNameIndex:=Item.NameIndex;
+      end;
+    {$ifdef pas2js}
+    Result:=buf.join('');
+    {$else}
+    SetLength(Result,buf.Size);
+    if Result<>'' then
+      Move(buf.Memory^,Result[1],buf.Size);
+    {$endif}
+  finally
+    {$ifdef pas2js}
+    {$else}
+    buf.Free;
+    {$endif}
+  end;
+end;
+
+procedure TSourceMap.ParseMappings(const Mapping: String);
+const
+  MaxInt = High(integer) div 2;
+{$ifdef UsePChar}
+var
+  p: PChar;
+
+  function Decode: NativeInt; inline;
+  begin
+    Result:=DecodeBase64VLQ(p);
+  end;
+
+  procedure E(const Msg: string);
+  begin
+    raise EJSSourceMap.CreateFmt(Msg,[PtrUInt(p-PChar(Mapping))+1]);
+  end;
+{$else}
+var
+  p: integer;
+
+  function Decode: NativeInt; inline;
+  begin
+    Result:=DecodeBase64VLQ(Mapping,p);
+  end;
+
+  procedure E(const Msg: string);
+  begin
+    raise EJSSourceMap.CreateFmt(Msg,[p]);
+  end;
+{$endif}
+var
+  GeneratedLine, LastColumn, Column, LastSrcFileIndex, LastSrcLine,
+    LastSrcColumn, LastNameIndex, SrcFileIndex, SrcLine, SrcColumn,
+    NameIndex, l: Integer;
+  ColDiff, SrcFileIndexDiff, SrcLineDiff, SrcColumnDiff,
+    NameIndexDiff: NativeInt;
+  Segment: TSourceMapSegment;
+begin
+  l:=length(Mapping);
+  if l=0 then exit;
+  p:={$ifdef UsePChar}PChar(Mapping){$else}1{$endif};
+  GeneratedLine:=1;
+  LastColumn:=0;
+  LastSrcFileIndex:=0;
+  LastSrcLine:=0;
+  LastSrcColumn:=0;
+  LastNameIndex:=0;
+  while {$ifdef UsePChar}true{$else}p<=l{$endif} do
+    begin
+    case {$ifdef UsePChar}p^{$else}Mapping[p]{$endif} of
+    {$ifdef UsePChar}
+    #0:
+      if p-PChar(Mapping)=length(Mapping) then
+        exit
+      else
+        E('unexpected #0 at %d');
+    {$endif}
+    ',':
+      begin
+      // next segment
+      inc(p);
+      end;
+    ';':
+      begin
+      // next line
+      inc(GeneratedLine);
+      inc(p);
+      end;
+    else
+      begin
+      ColDiff:=Decode;
+      if (ColDiff>MaxInt) or (ColDiff<-MaxInt) then
+        E('column out of range at %d');
+      Column:=LastColumn+integer(ColDiff);
+      if (Column>MaxInt) or (Column<-MaxInt) then
+        E('column out of range at %d');
+      LastColumn:=Column;
+
+      Segment:=TSourceMapSegment.Create;
+      Segment.Index:=FItems.Count;
+      FItems.Add(Segment);
+      Segment.GeneratedLine:=GeneratedLine;
+      Segment.GeneratedColumn:=Column;
+      Segment.SrcFileIndex:=-1;
+      Segment.NameIndex:=-1;
+      if {$ifdef UsePChar}not (p^ in [',',';',#0]){$else}(p<=l) and not (Mapping[p] in [',',';']){$endif} then
+        begin
+        // src file index
+        SrcFileIndexDiff:=Decode;
+        if (SrcFileIndexDiff>MaxInt) or (SrcFileIndexDiff<-MaxInt) then
+          E('src file index out of range at %d');
+        SrcFileIndex:=LastSrcFileIndex+integer(SrcFileIndexDiff);
+        if (SrcFileIndex<0) or (SrcFileIndex>=SourceCount) then
+          E('src file index out of range at %d');
+        LastSrcFileIndex:=SrcFileIndex;
+        Segment.SrcFileIndex:=SrcFileIndex;
+        // src line
+        SrcLineDiff:=Decode;
+        if (SrcLineDiff>MaxInt) or (SrcLineDiff<-MaxInt) then
+          E('src line out of range at %d');
+        SrcLine:=LastSrcLine+integer(SrcLineDiff);
+        if (SrcLine>MaxInt) or (SrcLine<-MaxInt) then
+          E('src line out of range at %d');
+        LastSrcLine:=SrcLine;
+        Segment.SrcLine:=SrcLine+1; // lines are stored 0-based
+        // src column
+        SrcColumnDiff:=Decode;
+        if (SrcColumnDiff>MaxInt) or (SrcColumnDiff<-MaxInt) then
+          E('src column out of range at %d');
+        SrcColumn:=LastSrcColumn+integer(SrcColumnDiff);
+        if (SrcColumn>MaxInt) or (SrcColumn<-MaxInt) then
+          E('src column out of range at %d');
+        LastSrcColumn:=SrcColumn;
+        Segment.SrcColumn:=SrcColumn;
+        if {$ifdef UsePChar}not (p^ in [',',';',#0]){$else}(p<=l) and not (Mapping[p] in [',',';']){$endif} then
+          begin
+          // name index
+          NameIndexDiff:=Decode;
+          if (NameIndexDiff>MaxInt) or (NameIndexDiff<-MaxInt) then
+            E('name index out of range at %d');
+          NameIndex:=LastNameIndex+integer(NameIndexDiff);
+          if (NameIndex<0) or (NameIndex>=NameCount) then
+            E('name index out of range at %d');
+          LastNameIndex:=NameIndex;
+          Segment.NameIndex:=NameIndex;
+          end;
+        end;
+      end;
+    end;
+    end;
+end;
+
+function TSourceMap.ToJSON: TJSONObject;
+var
+  Obj: TJSONObject;
+  i: Integer;
+  Arr: TJSONArray;
+  Mappings: String;
+begin
+  Result:=nil;
+  Mappings:=CreateMappings;
+
+  Obj:=TJSONObject.Create;
+  try
+    // "version" - integer
+    Obj.Add('version',Version);
+
+    // "file" - GeneratedFilename
+    if GeneratedFilename<>'' then
+      Obj.Add('file',GeneratedFilename);
+
+    // "sourceRoot" - SourceRoot
+    if SourceRoot<>'' then
+      Obj.Add('sourceRoot',SourceRoot);
+
+    // "sources" - array of filenames
+    Arr:=TJSONArray.Create;
+    Obj.Add('sources',Arr);
+    for i:=0 to SourceCount-1 do
+      Arr.Add(SourceTranslatedFiles[i]);
+
+    // "sourcesContent" - array of source content: null or source as string
+    // only needed if there is a source
+    i:=SourceCount-1;
+    while i>=0 do
+      if SourceContents[i]='' then
+        dec(i)
+      else
+        begin
+        // there is a source -> add array
+        Arr:=TJSONArray.Create;
+        Obj.Add('sourcesContent',Arr);
+        for i:=0 to SourceCount-1 do
+          if SourceContents[i]='' then
+            Arr.Add(TJSONNull.Create)
+          else
+            Arr.Add(SourceContents[i]);
+        break;
+        end;
+
+    // "names" - array of names
+    Arr:=TJSONArray.Create;
+    Obj.Add('names',Arr);
+    for i:=0 to NameCount-1 do
+      Arr.Add(Names[i]);
+
+    // "mappings" - string
+    Obj.Add('mappings',Mappings);
+
+    Result:=Obj;
+  finally
+    if Result=nil then
+      Obj.Free;
+  end;
+end;
+
+function TSourceMap.ToString: string;
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    if smoSafetyHeader in Options then
+      Result:=DefaultSrcMapHeader+Obj.AsJSON
+    else
+      Result:=Obj.AsJSON;
+  finally
+    Obj.Free;
+  end;
+end;
+
+procedure TSourceMap.LoadFromJSON(Obj: TJSONObject);
+var
+  aVersion, i, j: integer;
+  Arr: TJSONArray;
+  Data: TJSONData;
+  aFilename, aName: String;
+  aMappings: String;
+begin
+  // Note: does not support sections yet
+  Clear;
+
+  // "version" - integer
+  aVersion:=Obj.Get('version',0);
+  if aVersion<>Version then
+    raise EJSSourceMap.CreateFmt('unsupported version %d',[aVersion]);
+
+  // "file" - GeneratedFilename
+  GeneratedFilename:=String(Obj.Get('file',''));
+
+  // "sourceRoot" - SourceRoot
+  SourceRoot:=Obj.Get('sourceRoot','');
+
+  // "sources" - array of filenames
+  Arr:=nil;
+  if not Obj.Find('sources',Arr) then
+    raise EJSSourceMap.Create('missing sources array');
+  for i:=0 to Arr.Count-1 do
+    begin
+    Data:=Arr[i];
+    if not (Data is TJSONString) then
+      raise EJSSourceMap.CreateFmt('sources must string, but found %s',[Data.ClassName]);
+    aFilename:=String(TJSONString(Data).AsString);
+    j:=IndexOfSourceFile(aFilename,true);
+    if j<>i then
+      raise EJSSourceMap.CreateFmt('duplicate source file "%s" at %d',[aFilename,i]);
+    end;
+
+  // optional: "sourcesContent" - array of sources
+  Arr:=nil;
+  if Obj.Find('sourcesContent',Arr) then
+    begin
+    if Arr.Count<>SourceCount then
+      raise EJSSourceMap.CreateFmt('number of elements in sources %d mismatch sourcesContent %d',[SourceCount,Arr.Count]);
+    for i:=0 to Arr.Count-1 do
+      begin
+      Data:=Arr[i];
+      if (Data is TJSONString) then
+        SourceContents[i]:=String(TJSONString(Data).AsString)
+      else if Data is TJSONNull then
+      else
+        raise EJSSourceMap.CreateFmt('sourcesContent[%d] must be string',[i]);
+      end;
+    end;
+
+  // optional: "names" - array of strings
+  Arr:=nil;
+  if Obj.Find('names',Arr) then
+    for i:=0 to Arr.Count-1 do
+      begin
+      Data:=Arr[i];
+      if not (Data is TJSONString) then
+        raise EJSSourceMap.CreateFmt('names must string, but found %s',[Data.ClassName]);
+      aName:=String(TJSONString(Data).AsString);
+      j:=IndexOfName(aName,true);
+      if j<>i then
+        raise EJSSourceMap.CreateFmt('duplicate name "%s" at %d',[aName,i]);
+      end;
+
+  // "mappings" - string
+  aMappings:=Obj.Get('mappings','');
+  ParseMappings(aMappings);
+end;
+
+procedure TSourceMap.SaveToStream(aStream: TFPJSStream);
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    if smoSafetyHeader in Options then
+      begin
+      {$ifdef pas2js}
+      aStream.push(DefaultSrcMapHeader);
+      {$else}
+      aStream.Write(DefaultSrcMapHeader[1],length(DefaultSrcMapHeader));
+      {$endif}
+      end;
+    Obj.DumpJSON(aStream);
+  finally
+    Obj.Free;
+  end;
+end;
+
+{$ifdef HasStreams}
+procedure TSourceMap.LoadFromStream(aStream: TStream);
+var
+  s: string;
+  P: TJSONParser;
+  Data: TJSONData;
+begin
+  s:='';
+  SetLength(s,aStream.Size-aStream.Position);
+  if s<>'' then
+    aStream.Read(s[1],length(s));
+  if LeftStr(s,3)=')]}' then
+    Delete(s,1,3);
+  P:=TJSONParser.Create(s,[joUTF8]);
+  try
+    Data:=P.Parse;
+    if not (Data is TJSONObject) then
+      raise EJSSourceMap.Create('source map must be a JSON object');
+    LoadFromJSON(TJSONObject(Data));
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TSourceMap.SaveToFile(Filename: string);
+var
+  TheStream: TMemoryStream;
+begin
+  TheStream:=TMemoryStream.Create;
+  try
+    SaveToStream(TheStream);
+    TheStream.Position:=0;
+    TheStream.SaveToFile(Filename);
+  finally
+    TheStream.Free;
+  end;
+end;
+
+procedure TSourceMap.LoadFromFile(Filename: string);
+var
+  TheStream: TMemoryStream;
+begin
+  TheStream:=TMemoryStream.Create;
+  try
+    TheStream.LoadFromFile(Filename);
+    TheStream.Position:=0;
+    LoadFromStream(TheStream);
+  finally
+    TheStream.Free;
+  end;
+end;
+{$endif}
+
+function TSourceMap.IndexOfName(const Name: string; AddIfNotExists: boolean
+  ): integer;
+begin
+  Result:=FNameToIndex.FindValue(Name);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Result:=FNames.Count;
+  FNames.Add(Name);
+  FNameToIndex.Add(Name,Result);
+end;
+
+function TSourceMap.IndexOfSourceFile(const SrcFile: string;
+  AddIfNotExists: boolean): integer;
+var
+  Src: TSourceMapSrc;
+begin
+  Result:=FSourceToIndex.FindValue(SrcFile);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Src:=TSourceMapSrc.Create;
+  Src.Filename:=SrcFile;
+  Src.TranslatedFilename:=SrcFile;
+  Result:=FSources.Count;
+  FSources.Add(Src);
+  FSourceToIndex.Add(SrcFile,Result);
+end;
+
+function TSourceMap.IndexOfSegmentAt(GeneratedLine, GeneratedCol: integer
+  ): integer;
+var
+  l, r, m: Integer;
+  aSeg: TSourceMapSegment;
+begin
+  Sort;
+  l:=0;
+  r:=Count-1;
+  aSeg:=nil;
+  while l<=r do
+    begin
+    m:=(l+r) div 2;
+    aSeg:=Items[m];
+    if aSeg.GeneratedLine<GeneratedLine then
+      l:=m+1
+    else if aSeg.GeneratedLine>GeneratedLine then
+      r:=m-1
+    else if aSeg.GeneratedColumn<GeneratedCol then
+      l:=m+1
+    else if aSeg.GeneratedColumn>GeneratedCol then
+      r:=m-1
+    else
+      begin
+      // exact match found
+      Result:=m;
+      // -> return the leftmost exact match
+      while Result>0 do
+        begin
+        aSeg:=Items[Result-1];
+        if (aSeg.GeneratedLine<>GeneratedLine)
+            or (aSeg.GeneratedColumn<>GeneratedCol) then
+          exit;
+        dec(Result);
+        end;
+      exit;
+      end;
+    end;
+  // no exact match found
+  if aSeg=nil then
+    exit(-1);
+  // return the next lower. Note: there may be no such segment
+  if (aSeg.GeneratedLine>GeneratedLine)
+      or ((aSeg.GeneratedLine=GeneratedLine) and (aSeg.GeneratedColumn>GeneratedCol)) then
+    dec(m);
+  Result:=m;
+end;
+
+function TSourceMap.Count: integer;
+begin
+  Result:=FItems.Count;
+end;
+
+function TSourceMap.SourceCount: integer;
+begin
+  Result:=FSources.Count;
+end;
+
+function TSourceMap.NameCount: integer;
+begin
+  Result:=FNames.Count;
+end;
+
+end.
+

+ 93 - 0
compiler/packages/fcl-js/src/jstoken.pp

@@ -0,0 +1,93 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript token definitions
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+unit jstoken;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+
+  TJSToken = (tjsUnknown,
+     // Specials
+     tjsEOF,tjsWhiteSpace,tjsChar,tjsString{this bites TJSString}, tjsIdentifier,tjsNumber, tjsComment,tjsREGEX, tjsRESERVED,
+     tjsANDAND, tjsANDEQ,
+     tjsBraceOpen,tjsBraceClose,tjsSQuaredBraceOpen,tjsSQuaredBraceClose,tjsCurlyBraceOpen,tjsCurlyBraceClose,
+     tjsCOMMA,tjsCOLON,  tjsDOT,tjsSEMICOLON, tjsASSIGN,tjsGT,tjsLT, tjsConditional,
+     tjsPLUS,tjsMINUS,tjsMUL,tjsDIV,tjsAnd,tjsOR, tjsInv, tjsMod, tjsXOR, tjsNot,
+     tjsEQ,
+     tjsGE,
+     tjsLE, tjsLSHIFT, tjsLSHIFTEQ,
+     tjsMINUSEQ, tjsMINUSMINUS, tjsMODEQ,tjsDIVEQ,tjsXOREq,
+     tjsNE,
+     tjsOREQ, tjsOROR,
+     tjsPLUSEQ, tjsPLUSPLUS,
+     tjsURSHIFT, tjsURSHIFTEQ,
+     tjsRSHIFT, tjsRSHIFTEQ,
+     tjsSEQ, tjsSNE, tjsMULEQ,
+     { Reserved words start here. They must be last }
+     tjsBREAK,tjsCASE, tjsCATCH, tjsCONTINUE,
+     tjsDEFAULT, tjsDELETE, tjsDO,
+     tjsELSE,
+     tjsFalse, tjsFINALLY, tjsFOR, tjsFUNCTION,
+     tjsIF, tjsIN, tjsINSTANCEOF,
+     tjsNEW,tjsNULL,
+     tjsRETURN,
+     tjsSWITCH,
+     tjsTHIS, tjsTHROW, tjsTrue, tjsTRY, tjsTYPEOF,
+     tjsVAR, tjsVOID,
+     tjsWHILE, tjsWITH
+   );
+
+const
+  FirstKeyword = tjsBreak;
+  LastKeyWord = tJSWith;
+
+  TokenInfos: array[TJSToken] of string = ('unknown',
+       // Specials
+        'EOF','whitespace','Char','String', 'identifier','number','comment','regular expression', 'reserved word',
+        '&&','&=',
+        '(',')','[',']','{','}',
+        ',',':','.',';','=','>','<','?',
+        '+','-','*','/','&','|','~','%','^','!',
+        '==',
+        '>=',
+        '<=', '<<', '<<=',
+        '-=', '--', '%=', '/=','^=',
+        '!=',
+        '|=', '||',
+        '+=', '++',
+        '>>>', '>>>=',
+        '>>', '>>=',
+        '===', '!==', '*=',
+        // Identifiers last
+        'break','case','catch', 'continue',
+     'default','delete', 'do',
+     'else',
+     'false','finally', 'for', 'function',
+     'if', 'in', 'instanceof',
+     'new','null',
+     'return',
+     'switch',
+     'this', 'throw', 'true', 'try', 'typeof',
+     'var', 'void',
+     'while', 'with'
+    );
+
+
+implementation
+
+end.
+

+ 1964 - 0
compiler/packages/fcl-js/src/jstree.pp

@@ -0,0 +1,1964 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript syntax tree definitions
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+unit jstree;
+
+{$mode objfpc}{$H+}
+{ $DEFINE NOCLASSES}
+
+interface
+
+uses
+{$IFNDEF NOCLASSES}  Classes, {$ENDIF} SysUtils, jsbase, jstoken;
+
+Type
+{$IFDEF NOCLASSES}
+
+  { TStrings }
+{$M+}
+  TStrings = Class(TObject)
+  private
+    FCount: Integer;
+    FStrings : Array of String;
+    function GetCount: Integer;
+    function GetS(AIndex : Integer): String;
+    procedure SetS(AIndex : Integer; AValue: String);
+  Public
+    Function Add(Const S : String) : Integer;
+    Procedure Assign(Source : TStrings);
+    Property Strings[AIndex : Integer] : String Read GetS Write SetS; default;
+    Property Count : Integer Read GetCount;
+  end;
+  TStringList = TStrings;
+  EListError = Class(Exception);
+
+  TCollection = Class;
+
+  { TCollectionItem }
+
+  TCollectionItem = Class
+  Private
+    FCollection : TCollection;
+  Public
+    Constructor Create(ACollection : TCollection);
+    Destructor Destroy; override;
+  end;
+  TCollectionItemClass = Class of TCollectionItem;
+
+  { TCollection }
+
+  TCollection = Class
+  private
+    FCount: Integer;
+    FItems : Array of TCollectionItem;
+    FItemClass : TCollectionItemClass;
+    function GetCount: Integer;
+    function GetI(AIndex : Integer): TCollectionItem;
+  public
+    Constructor Create(AItemClass : TCollectionItemClass);
+    Destructor Destroy; override;
+    Procedure Clear;
+    Procedure Remove(AItem : TCollectionItem);
+    Function Add : TCollectionItem;
+    Property Items[AIndex : Integer] : TCollectionItem Read GetI;default;
+    Property Count : Integer Read GetCount;
+  end;
+
+{$M-}
+{$ENDIF}
+  TJSElementFlag = (elIsConst,elIsConstValid);
+  TJSElementFlags = set of TJSElementFlag;
+
+  TJSFunctionBody = Class;
+
+  { TJSElement }
+
+  TJSObject = Class(TObject);
+
+
+  { TJSLabelSet }
+
+  TJSLabelSet = Class(TJSObject)
+  private
+    FCont: Boolean;
+    FNext: TJSLabelSet;
+    FTarget: Cardinal;
+  Public
+    Property Target : Cardinal Read FTarget Write FTarget;
+    Property Next : TJSLabelSet Read FNext Write FNext; // Linked list
+    Property Continuable : Boolean Read FCont Write FCont;
+  end;
+
+  { TJSLabel }
+
+  TJSLabel = Class(TJSObject)
+  private
+    FLabelSet: TJSLabelSet;
+    FLocationLine: Integer;
+    FLocationPos: Integer;
+    FLocationSource: String;
+    FName: String;
+    FNext: TJSLabel;
+  Public
+    Property Name : String Read FName Write FName;
+    Property LabelSet : TJSLabelSet Read FLabelSet Write FLabelSet;
+    Property LocationSource : String Read FLocationSource Write FLocationSource;
+    Property LocationLine : Integer Read FLocationLine Write FLocationLine;
+    Property LocationPos : Integer Read FLocationPos Write FLocationPos;
+    Property Next : TJSLabel Read FNext Write FNext;
+  end;
+
+  TJSString = jsbase.TJSString; // beware of jstoken.tjsString
+
+  { TJSFuncDef - part of TJSFunctionDeclarationStatement, e.g. 'function Name(Params)Body' }
+
+  TJSFuncDef = Class(TJSObject)
+  private
+    FBody: TJSFunctionBody;
+    FIsEmpty: Boolean;
+    FName: TJSString;
+    FParams: TStrings;
+    procedure SetParams(const AValue: TStrings);
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
+    Property Params : TStrings Read FParams Write SetParams;
+    Property Body : TJSFunctionBody Read FBody Write FBody; // can be nil
+    Property Name : TJSString Read FName Write FName;
+    Property IsEmpty : Boolean Read FIsEmpty Write FIsEmpty;
+  end;
+
+  { TJSElement }
+
+  TJSElement = Class(TJSObject)
+  private
+    FFlags: TJSElementFlags;
+    FLine: Integer;
+    FColumn: Integer;
+    FSource: String;
+  Public
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); virtual;
+    Procedure AssignPosition(El: TJSElement); virtual;
+    Property Source : String Read FSource Write FSource;
+    Property Line : Integer Read FLine Write FLine;
+    Property Column : Integer Read FColumn Write FColumn;
+    Property Flags : TJSElementFlags Read FFlags Write FFlags;
+  end;
+  TJSElementClass = Class of TJSElement;
+
+  { TJSEmptyBlockStatement - empty curly brackets }
+
+  TJSEmptyBlockStatement = Class(TJSElement);
+
+  { TJSEmptyStatement - a dummy placeholder, needs sometimes a single semicolon }
+
+  TJSEmptyStatement = Class(TJSElement);
+
+  { TJSLiteral }
+
+  TJSLiteral = Class(TJSElement)
+  private
+    FValue: TJSValue;
+  Public
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
+    Destructor Destroy; override;
+    Property Value : TJSValue Read FValue Write FValue;
+  end;
+
+  { TJSRegularExpressionLiteral - /Pattern/PatternFlags }
+
+  TJSRegularExpressionLiteral = Class(TJSElement)
+  private
+    FPattern: TJSValue;
+    FPatternFlags: TJSValue;
+    FArgv : Array[0..1] of TJSValue;
+    function GetA(AIndex : integer): TJSValue;
+    procedure SetA(AIndex : integer; const AValue: TJSValue);
+  Public
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
+    Destructor Destroy; override;
+    Property Pattern : TJSValue Read FPattern Write FPattern;
+    Property PatternFlags : TJSValue Read FPatternFlags Write FPatternFlags;
+    Property Argv[AIndex : integer] : TJSValue Read GetA Write SetA;
+  end;
+
+  TJSPrimaryExpression = Class(TJSElement);
+
+  TJSPrimaryExpressionThis = Class(TJSPrimaryExpression); // 'this'
+
+  { TJSPrimaryExpressionIdent }
+
+  TJSPrimaryExpressionIdent = Class(TJSPrimaryExpression)
+  private
+    FName: TJSString;
+  Public
+    Property Name : TJSString Read FName Write FName;
+  end;
+
+  { TJSArrayLiteralElement - an item of a TJSArrayLiteralElements }
+
+  TJSArrayLiteralElement = Class(TCollectionItem)
+  private
+    FExpr: TJSelement;
+    FElementIndex: Integer;
+  Public
+    Destructor Destroy; override;
+    Property Expr : TJSElement Read FExpr Write FExpr;
+    Property ElementIndex : Integer Read FElementIndex Write FElementIndex;
+  end;
+
+  { TJSArrayLiteralElements - Elements property of TJSArrayLiteral }
+
+  TJSArrayLiteralElements = Class(TCollection)
+  private
+    function GetE(AIndex : Integer): TJSArrayLiteralElement;
+  Public
+    Function AddElement : TJSArrayLiteralElement;
+    Property Elements[AIndex : Integer] : TJSArrayLiteralElement Read GetE ; default;
+  end;
+
+  { TJSArrayLiteral - [element1,...] }
+
+  TJSArrayLiteral = Class(TJSElement)
+  private
+    FElements: TJSArrayLiteralElements;
+  Public
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    procedure AddElement(El: TJSElement);
+    Destructor Destroy; override;
+    Property Elements : TJSArrayLiteralElements Read FElements;
+  end;
+
+  { TJSObjectLiteralElement - an item of TJSObjectLiteralElements }
+
+  TJSObjectLiteralElement = Class(TCollectionItem)
+  private
+    FExpr: TJSelement;
+    FName: TJSString;
+  Public
+    Destructor Destroy; override;
+    Property Expr : TJSElement Read FExpr Write FExpr;
+    Property Name : TJSString Read FName Write FName;
+  end;
+
+  { TJSObjectLiteralElements - Elements property of TJSObjectLiteral }
+
+  TJSObjectLiteralElements = Class(TCollection)
+  private
+    function GetE(AIndex : Integer): TJSObjectLiteralElement;
+  Public
+    Function AddElement : TJSObjectLiteralElement;
+    Property Elements[AIndex : Integer] : TJSObjectLiteralElement Read GetE ; default;
+  end;
+
+  { TJSObjectLiteral }
+
+  TJSObjectLiteral = Class(TJSElement)
+  private
+    FElements: TJSObjectLiteralElements;
+  Public
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    Destructor Destroy; override;
+    Property Elements : TJSObjectLiteralElements Read FElements;
+  end;
+
+  { TJSArguments - (element1,...) }
+
+  TJSArguments = Class(TJSArrayLiteral);
+
+  { TJSMemberExpression - base class }
+
+  TJSMemberExpression = Class(TJSElement)
+  private
+    FMexpr: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property MExpr : TJSElement Read FMexpr Write FMexpr;
+  end;
+
+  { TJSNewMemberExpression - e.g. 'new MExpr(Args)' }
+
+  TJSNewMemberExpression = Class(TJSMemberExpression)
+  private
+    FArgs: TJSArguments;
+  Public
+    Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
+    Property Args : TJSArguments Read FArgs Write FArgs;
+  end;
+
+  { TJSDotMemberExpression - e.g. 'MExpr.Name' }
+
+  TJSDotMemberExpression = Class(TJSMemberExpression)
+  private
+    FName: TJSString;
+  Public
+    Property Name : TJSString Read FName Write FName;
+  end;
+
+  { TJSBracketMemberExpression - e.g. 'MExpr[Name]' }
+
+  TJSBracketMemberExpression = Class(TJSMemberExpression)
+  private
+    FName: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Name : TJSElement Read FName Write FName;
+  end;
+
+  { TJSCallExpression - e.g. 'Expr(Args)'}
+
+  TJSCallExpression = Class(TJSElement)
+  private
+    FArgs: TJSArguments;
+    FExpr: TJSElement;
+  Public
+    Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
+    Property Expr : TJSElement Read FExpr Write FExpr;
+    Property Args : TJSArguments Read FArgs Write FArgs;
+  end;
+
+  { TJSUnary - e.g. 'PrefixOperator A PostFixOperator', '--i' }
+
+  TJSUnary = Class(TJSElement)
+  private
+    FA: TJSElement;
+  Public
+    Class function PrefixOperatorToken : tjsToken; virtual;
+    Class function PostFixOperatorToken : tjsToken; virtual;
+    Class function PrefixOperator : String;
+    Class function PostFixOperator : String;
+    Destructor Destroy; override;
+    Property A : TJSElement Read FA Write FA;
+  end;
+  TJSUnaryClass = class of TJSUnary;
+
+  { TJSVariableStatement - e.g. 'var A' }
+
+  TJSVariableStatement = Class(TJSUnary);
+
+  { TJSExpressionStatement - A; }
+
+  TJSExpressionStatement = Class(TJSUnary);
+
+  { TJSThrowStatement - e.g. 'throw A' }
+
+  TJSThrowStatement = Class(TJSUnary)
+  Public
+    Class function PrefixOperatorToken : tjsToken; Override;
+  end;
+
+  TJSUnaryExpression = Class(TJSUnary);
+
+  { TJSUnaryDeleteExpression - e.g. 'delete A' }
+
+  TJSUnaryDeleteExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryVoidExpression - e.g. 'void A' }
+
+  TJSUnaryVoidExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryTypeOfExpression - e.g. 'typeof A' }
+
+  TJSUnaryTypeOfExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryPrePlusPlusExpression - e.g. '++A' }
+
+  TJSUnaryPrePlusPlusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryPreMinusMinusExpression - e.g. '--A' }
+
+  TJSUnaryPreMinusMinusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryPlusExpression - e.g. '+A' }
+
+  TJSUnaryPlusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryMinusExpression - e.g. '-A' }
+
+  TJSUnaryMinusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryInvExpression - e.g. '~A' }
+
+  TJSUnaryInvExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryNotExpression - e.g. '!A' }
+
+  TJSUnaryNotExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryPostPlusPlusExpression - e.g. 'A++' }
+
+  TJSUnaryPostPlusPlusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PostFixOperatorToken : tjsToken; override;
+  end;
+
+  { TJSUnaryPostMinusMinusExpression - e.g. 'A--' }
+
+  TJSUnaryPostMinusMinusExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PostFixOperatorToken : tjsToken; override;
+  end;
+
+
+  { TJSBinary - base class }
+
+  TJSBinary = Class(TJSElement)
+  private
+    FA: TJSElement;
+    FB: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property A : TJSElement Read FA Write FA;
+    Property B : TJSElement Read FB Write FB;
+  end;
+  TJSBinaryClass = Class of TJSBinary;
+
+  { TJSStatementList - a list of statements enclosed in curly brackets }
+
+  TJSStatementList = Class(TJSBinary); // A->first statement, B->next in list, chained.
+
+  { TJSVariableDeclarationList }
+
+  TJSVariableDeclarationList = Class(TJSBinary); // A->first variable, B->next in list, chained.
+
+  { TJSWithStatement - with(A)do B; }
+
+  TJSWithStatement = Class(TJSBinary); // A-> with expression, B->statement(s)
+
+  { TJSBinaryExpression - e.g. A operator B }
+
+  TJSBinaryExpression = Class(TJSBinary)
+  Public
+    Class function OperatorToken : tjsToken; virtual;
+    Class function OperatorString : string;
+    Class Function AllowCompact : Boolean; virtual;
+  end;
+
+  { TJSLogicalOrExpression - e.g. A || B }
+
+  TJSLogicalOrExpression = Class (TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSLogicalAndExpression - e.g. A && B }
+
+  TJSLogicalAndExpression = Class (TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSBitwiseAndExpression - e.g. A & B }
+
+  TJSBitwiseAndExpression = Class (TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSBitwiseOrExpression - e.g. A | B }
+
+  TJSBitwiseOrExpression = Class (TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSBitwiseXOrExpression - e.g. A ^ B }
+
+  TJSBitwiseXOrExpression = Class (TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  TJSEqualityExpression = Class (TJSBinaryExpression);
+
+  { TJSEqualityExpressionEQ - e.g. A == B }
+
+  TJSEqualityExpressionEQ = Class(TJSEqualityExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSEqualityExpressionNE - e.g. A != B }
+
+  TJSEqualityExpressionNE = Class(TJSEqualityExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSEqualityExpressionSEQ strict equal - e.g. A === B }
+
+  TJSEqualityExpressionSEQ = Class(TJSEqualityExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSEqualityExpressionSNE not strict equal - e.g. A !== B }
+
+  TJSEqualityExpressionSNE = Class(TJSEqualityExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  TJSRelationalExpression = Class(TJSBinaryExpression);
+
+  { TJSRelationalExpressionLT lower than - e.g. A < B }
+
+  TJSRelationalExpressionLT = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRelationalExpressionGT greater than - e.g. A > B }
+
+  TJSRelationalExpressionGT = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRelationalExpressionLE lower equal - e.g. A <= B }
+
+  TJSRelationalExpressionLE = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRelationalExpressionGE greater equal - e.g. A >= B }
+
+  TJSRelationalExpressionGE = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRelationalExpressionIn - e.g. A in B }
+
+  TJSRelationalExpressionIn = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+    Class Function AllowCompact : Boolean; override;
+  end;
+
+  { TJSRelationalExpressionInstanceOf - e.g. A instanceof B }
+
+  TJSRelationalExpressionInstanceOf = Class(TJSRelationalExpression)
+    Class function OperatorToken : tjsToken; override;
+    Class Function AllowCompact : Boolean; override;
+  end;
+
+  TJSShiftExpression = Class(TJSBinaryExpression);
+
+  { TJSLShiftExpression - e.g. A << B }
+
+  TJSLShiftExpression = Class(TJSShiftExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRShiftExpression right shift keep sign - e.g. A >> B }
+
+  TJSRShiftExpression = Class(TJSShiftExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSURShiftExpression right shift unsigned, insert zeroes - e.g. A >>> B }
+
+  TJSURShiftExpression = Class(TJSShiftExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  TJSAdditiveExpression = Class(TJSBinaryExpression);
+
+  { TJSAdditiveExpressionPlus - e.g. A + B }
+
+  TJSAdditiveExpressionPlus = Class(TJSAdditiveExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSAdditiveExpressionMinus - e.g. A - B }
+
+  TJSAdditiveExpressionMinus = Class(TJSAdditiveExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  TJSMultiplicativeExpression = Class(TJSBinaryExpression);
+
+  { TJSMultiplicativeExpressionMul - e.g. A * B }
+
+  TJSMultiplicativeExpressionMul = Class(TJSMultiplicativeExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSMultiplicativeExpressionDiv - e.g. A / B }
+
+  TJSMultiplicativeExpressionDiv = Class(TJSMultiplicativeExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSMultiplicativeExpressionMod - e.g. A % B }
+
+  TJSMultiplicativeExpressionMod = Class(TJSMultiplicativeExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSCommaExpression - e.g. A , B }
+
+  TJSCommaExpression = Class(TJSBinaryExpression)
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSConditionalExpression - e.g. A ? B :C }
+
+  TJSConditionalExpression = Class(TJSElement)
+  private
+    FA: TJSElement;
+    FB: TJSElement;
+    FC: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property A : TJSElement Read FA Write FA;
+    Property B : TJSElement Read FB Write FB;
+    Property C : TJSElement Read FC Write FC;
+  end;
+
+  { TJSAssignStatement - e.g. LHS operator Expr }
+
+  TJSAssignStatement = Class(TJSElement)
+  private
+    FExpr: TJSElement;
+    FLHS: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Class function OperatorToken : tjsToken; virtual;
+    Class function OperatorString : String;
+    Property Expr : TJSElement Read FExpr Write FExpr;
+    Property LHS : TJSElement Read FLHS Write FLHS;
+  end;
+
+  TJSAssignStatementClass = Class of TJSAssignStatement;
+
+  { TJSSimpleAssignStatement - e.g. LHS=Expr }
+
+  TJSSimpleAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSMulEqAssignStatement - e.g. LHS*=Expr }
+
+  TJSMulEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSDivEqAssignStatement - e.g. LHS/=Expr }
+
+  TJSDivEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSModEqAssignStatement - e.g. LHS%=Expr }
+
+  TJSModEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSAddEqAssignStatement - e.g. LHS+=Expr }
+
+  TJSAddEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSSubEqAssignStatement - e.g. LHS-=Expr }
+
+  TJSSubEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSLShiftEqAssignStatement - e.g. LHS<<=Expr }
+
+  TJSLShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSRShiftEqAssignStatement - e.g. LHS>>=Expr keep sign }
+
+  TJSRShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSURShiftEqAssignStatement - e.g. LHS>>>=Expr unsigned, insert zeroes }
+
+  TJSURShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSANDEqAssignStatement - e.g. LHS&=Expr }
+
+  TJSANDEqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSOREqAssignStatement - e.g. LHS|=Expr }
+
+  TJSOREqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSXOREqAssignStatement - e.g. LHS^=Expr }
+
+  TJSXOREqAssignStatement = Class(TJSAssignStatement)
+  Public
+    Class function OperatorToken : tjsToken; override;
+  end;
+
+  { TJSVarDeclaration - e.g. Name=Init }
+
+  TJSVarDeclaration = Class(TJSElement)
+  private
+    FInit: TJSElement;
+    FName: String;
+  Public
+    Destructor Destroy; override;
+    Property Name : String Read FName Write FName;
+    Property Init : TJSElement Read FInit Write FInit;
+  end;
+
+  { TJSIfStatement - e.g. if (Cond) btrue else bfalse }
+
+  TJSIfStatement = Class(TJSElement)
+  private
+    FBFalse: TJSElement;
+    FBTrue: TJSElement;
+    FCond: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Cond : TJSElement Read FCond Write FCond;
+    Property BTrue : TJSElement Read FBTrue Write FBTrue;
+    Property BFalse : TJSElement Read FBFalse Write FBFalse;
+  end;
+
+  { TJSTargetStatement
+    - base class for statements targetable by continue and break
+    - TargetName can be empty }
+
+  TJSTargetStatement = Class(TJSElement)
+  private
+    FTarget: Cardinal;
+    FTargetName: TJSString;
+  Public
+    Property Target : Cardinal Read FTarget Write FTarget;
+    Property TargetName : TJSString Read FTargetName Write FTargetName;
+  end;
+
+  { TJSBodyStatement - base class }
+
+  TJSBodyStatement = Class(TJSTargetStatement)
+  private
+    FBody: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Body : TJSElement Read FBody Write FBody;
+  end;
+
+  { TJSCondLoopStatement - base class for do..while and while..do }
+
+  TJSCondLoopStatement = Class(TJSBodyStatement)
+  private
+    FCond: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Cond : TJSElement Read FCond Write FCond;
+  end;
+
+  { TJSWhileStatement - e.g. 'while(Cond) Body' }
+
+  TJSWhileStatement = Class(TJSCondLoopStatement);
+
+  { TJSDoWhileStatement - e.g. 'do Body while(Cond)' }
+
+  TJSDoWhileStatement = Class(TJSWhileStatement);
+
+  { TJSForStatement - e.g. 'for(Init;Cond;Incr) Body' }
+
+  TJSForStatement = Class(TJSCondLoopStatement)
+  private
+    FIncr: TJSElement;
+    FInit: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Incr : TJSElement Read FIncr Write FIncr;
+    Property Init : TJSElement Read FInit Write FInit;
+  end;
+
+  { TJSForInStatement - e.g. 'for(LHS in List) Body' }
+
+  TJSForInStatement = Class(TJSBodyStatement)
+  private
+    FLhs: TJSElement;
+    FList: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property LHS : TJSElement Read FLHS Write FLHS;
+    Property List : TJSElement Read FList Write FList;
+  end;
+
+  { TJSContinueStatement - e.g. 'continue'}
+
+  TJSContinueStatement = Class(TJSTargetStatement);
+
+  { TJSBreakStatement - e.g. 'break' }
+
+  TJSBreakStatement = Class(TJSTargetStatement);
+
+  { TJSReturn - e.g. 'return Expr'}
+
+  TJSReturnStatement = Class(TJSElement)
+  private
+    FExpr: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Expr : TJSElement Read FExpr Write FExpr;
+  end;
+
+  { TJSCaseElement - element of TJSCaseElements, e.g. 'case Expr: Body' }
+
+  TJSCaseElement = Class(TCollectionItem)
+  private
+    FBody: TJSElement;
+    FExpr: TJSelement;
+  Public
+    Destructor Destroy; override;
+    Property Expr : TJSelement Read FExpr Write FExpr;
+    Property Body : TJSElement Read FBody Write FBody;
+  end;
+
+  { TJSCaseElements - Cases property of TJSSwitch }
+
+  TJSCaseElements = Class(TCollection)
+  private
+    function GetC(AIndex : Integer): TJSCaseElement;
+  Public
+    Function AddCase : TJSCaseElement;
+    Property Cases[AIndex : Integer] : TJSCaseElement Read GetC ;default;
+  end;
+
+  { TJSSwitch - e.g. switch(Cond) Cases }
+
+  TJSSwitchStatement = Class(TJSTargetStatement)
+  private
+    FCases: TJSCaseElements;
+    FCond: TJSelement;
+    FDefault: TJSCaseElement;
+  Public
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    Destructor Destroy; override;
+    Property Cond : TJSElement Read FCond Write FCond;
+    Property Cases : TJSCaseElements Read FCases;
+    Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases
+  end;
+
+  { TJSLabeledStatement - e.g. 'TheLabel : A' }
+
+  TJSLabeledStatement = Class(TJSUnary)
+  private
+    FLabel: TJSLabel;
+    FTarget: Integer;
+  Public
+    Destructor Destroy; override;
+    Property Target: Integer Read FTarget Write FTarget;
+    Property TheLabel : TJSLabel Read FLabel Write Flabel;
+  end;
+
+  { TJSTryStatement - e.g. 'try Block catch(Ident) BCatch finally BFinally' }
+
+  TJSTryStatement = Class(TJSElement)
+  private
+    FBCatch: TJSElement;
+    FBFinally: TJSElement;
+    FBlock: TJSElement;
+    FIdent: TJSString;
+  Public
+    Destructor Destroy; override;
+    Property Block : TJSElement Read FBlock Write FBlock;
+    Property BCatch : TJSElement Read FBCatch Write FBCatch;
+    Property BFinally : TJSElement Read FBFinally Write FBFinally;
+    Property Ident : TJSString Read FIdent Write FIDent;
+  end;
+
+  TJSTryCatchFinallyStatement = Class(TJSTryStatement);
+  TJSTryCatchStatement = Class(TJSTryStatement);
+  TJSTryFinallyStatement = Class(TJSTryStatement);
+
+
+  { TJSFunctionDeclarationStatement - same as TJSFuncDef, except as a TJSElement }
+
+  TJSFunctionDeclarationStatement = Class(TJSElement)
+  private
+    FFuncDef: TJSFuncDef;
+  Public
+    Destructor Destroy; override;
+    Property AFunction : TJSFuncDef Read FFuncDef Write FFuncDef;
+  end;
+
+  { TJSFunctionBody - the statement block of a function }
+
+  TJSFunctionBody = Class(TJSUnary)
+  private
+    FIsProgram: Boolean;
+  Public
+    Property isProgram : Boolean Read FIsProgram Write FIsProgram;
+  end;
+
+  { TJSElementNode - element of TJSElementNodes }
+
+  TJSElementNode = Class(TCollectionItem)
+  private
+    FNode: TJSElement;
+  Public
+    Destructor Destroy; override;
+    Property Node : TJSElement Read FNode Write FNode;
+  end;
+
+  { TJSElementNodes - see TJSSourceElements }
+
+  TJSElementNodes = Class(TCollection)
+  private
+    function GetN(AIndex : Integer): TJSElementNode;
+  Public
+    Function AddNode : TJSElementNode;
+    Property Nodes[AIndex : Integer] : TJSElementNode Read GetN ; default;
+  end;
+
+  { TJSSourceElements - a list of elements, every element ends in semicolon,
+    first Vars, then Functions, finally Statements }
+
+  TJSSourceElements = Class(TJSElement)
+  private
+    FFunctions: TJSElementNodes;
+    FStatements: TJSElementNodes;
+    FVars: TJSElementNodes;
+  Public
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    Destructor Destroy; override;
+    Property Vars : TJSElementNodes Read FVars;
+    Property Functions : TJSElementNodes Read FFunctions;
+    Property Statements : TJSElementNodes Read FStatements;
+  end;
+
+implementation
+
+{$IFDEF NOCLASSES}
+{ TCollectionItem }
+
+Constructor TCollectionItem.Create(ACollection: TCollection);
+begin
+  FCollection:=ACollection;
+end;
+
+Destructor TCollectionItem.Destroy;
+begin
+  if Assigned(FCollection) then
+    FCollection.Remove(Self);
+  inherited Destroy;
+end;
+
+{ TCollection }
+
+function TCollection.GetI(AIndex : Integer): TCollectionItem;
+begin
+  if (AIndex>=0) and (AIndex<FCount) then
+    Result:=FItems[AIndex]
+  else
+    Raise EListError.CreateFmt('Collection index (%d) out of bounds.',[AIndex]);
+end;
+
+function TCollection.GetCount: Integer;
+begin
+  Result:=FCount;
+end;
+
+Procedure TCollection.Remove(AItem: TCollectionItem);
+
+Var
+  I,J : Integer;
+
+begin
+  if (AItem=Nil)  then exit;
+  I:=Count-1;
+  While (I>=0) and (FItems[I]<>AItem) do
+    Dec(i);
+  For J:=I to Count-2 do
+    FItems[I]:=FItems[i+1];
+  Dec(FCount);
+end;
+
+Constructor TCollection.Create(AItemClass: TCollectionItemClass);
+begin
+  FItemClass:=AItemClass;
+end;
+
+Destructor TCollection.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+Procedure TCollection.Clear;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Count-1 do
+    begin
+    FItems[i].FCollection:=Nil;
+    FItems[i].Destroy;
+    end;
+  FCount:=0;
+  SetLength(Fitems,0);
+end;
+
+Function TCollection.Add: TCollectionItem;
+Var
+  NL : Integer;
+begin
+  If FCount=Length(FItems) then
+    begin
+    NL:=Length(FItems)*3 div 2;
+    if NL=0 then NL:=10;
+    SetLength(FItems,NL);
+    end;
+  Result:=FItemClass.Create(Self);
+  FItems[FCount]:=Result;
+  Inc(FCount);
+end;
+
+{ TStrings }
+
+function TStrings.GetCount: Integer;
+begin
+  Result:=FCount;
+end;
+
+function TStrings.GetS(AIndex : Integer): String;
+begin
+  if (AIndex>=0) and (AIndex<FCount) then
+    Result:=FStrings[AIndex]
+  else
+    Raise EListError.CreateFmt('List index (%d) out of bounds.',[AIndex]);
+end;
+
+procedure TStrings.SetS(AIndex : Integer; AValue: String);
+begin
+  if (AIndex>=0) and (AIndex<=FCount) then
+    begin
+    if (AIndex=FCount) then
+      Add(AValue)
+    else
+      FStrings[AIndex]:=AValue;
+    end
+  else
+    Raise EListError.CreateFmt('List index (%d) out of bounds.',[AIndex]);
+end;
+
+Function TStrings.Add(Const S: String): Integer;
+
+Var
+  NL : Integer;
+begin
+  If FCount=Length(FStrings) then
+    begin
+    NL:=Length(FStrings)*3 div 2;
+    if NL=0 then NL:=10;
+    SetLength(FStrings,NL);
+    end;
+  FStrings[FCount]:=S;
+  Inc(FCount);
+end;
+
+Procedure TStrings.Assign(Source: TStrings);
+
+Var
+  I : Integer;
+
+begin
+  SetLength(FStrings,Length(Source.FStrings));
+  FCount:=Source.FCount;
+  For I:=0 to FCount-1 do
+    FStrings[i]:=Source.FStrings[i];
+end;
+{$ENDIF NOCLASSES}
+
+{ TJSXOREqAssignStatement }
+
+Class function TJSXOREqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsXOREq;
+end;
+
+{ TJSOREqAssignStatement }
+
+Class function TJSOREqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsOREQ;
+end;
+
+{ TJSANDEqAssignStatement }
+
+Class function TJSANDEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsAndEq;
+end;
+
+{ TJSURShiftEqAssignStatement }
+
+Class function TJSURShiftEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsURSHIFTEQ;
+end;
+
+{ TJSRShiftEqAssignStatement }
+
+Class function TJSRShiftEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsRSHIFTEQ;
+end;
+
+{ TJSLShiftEqAssignStatement }
+
+Class function TJSLShiftEqAssignStatement.OperatorToken: tjsToken;
+begin
+   Result:=tjsLSHIFTEQ;
+end;
+
+{ TJSSubEqAssignStatement }
+
+Class function TJSSubEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsMINUSEQ;
+end;
+
+{ TJSAddEqAssignStatement }
+
+Class function TJSAddEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsPLUSEQ;
+end;
+
+{ TJSModEqAssignStatement }
+
+Class function TJSModEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsMODEQ;
+end;
+
+{ TJSDivEqAssignStatement }
+
+Class function TJSDivEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsDIVEQ;
+end;
+
+{ TJSMulEqAssignStatement }
+
+Class function TJSMulEqAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsMULEQ;
+end;
+
+{ TJSSimpleAssignStatement }
+
+Class function TJSSimpleAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsAssign;
+end;
+
+{ TJSLabeledStatement }
+
+Destructor TJSLabeledStatement.Destroy;
+begin
+  FreeAndNil(Flabel);
+  inherited Destroy;
+end;
+
+{ TJSCommaExpression }
+
+Class function TJSCommaExpression.OperatorToken: tjsToken;
+begin
+  Result:=tjsComma;
+end;
+
+{ TJSMultiplicativeExpressionMod }
+
+Class function TJSMultiplicativeExpressionMod.OperatorToken: tjsToken;
+begin
+  Result:=tjsMod;
+end;
+
+{ TJSMultiplicativeExpressionDiv }
+
+Class function TJSMultiplicativeExpressionDiv.OperatorToken: tjsToken;
+begin
+  Result:=tjsDiv;
+end;
+
+{ TJSMultiplicativeExpressionMul }
+
+Class function TJSMultiplicativeExpressionMul.OperatorToken: tjsToken;
+begin
+  Result:=tjsMul;
+end;
+
+{ TJSAdditiveExpressionMinus }
+
+Class function TJSAdditiveExpressionMinus.OperatorToken: tjsToken;
+begin
+  Result:=tjsMinus;
+end;
+
+{ TJSAdditiveExpressionPlus }
+
+Class function TJSAdditiveExpressionPlus.OperatorToken: tjsToken;
+begin
+  Result:=tjsPlus;
+end;
+
+{ TJSURShiftExpression }
+
+Class function TJSURShiftExpression.OperatorToken: tjsToken;
+begin
+  Result:=tjsURshift;
+end;
+
+{ TJSRShiftExpression }
+
+Class function TJSRShiftExpression.OperatorToken: tjsToken;
+begin
+  Result:=tjsRSHIFT;
+end;
+
+{ TJSLShiftExpression }
+
+Class function TJSLShiftExpression.OperatorToken: tjsToken;
+begin
+  Result:=tjsLSHIFT;
+end;
+
+{ TJSRelationalExpressionInstanceOf }
+
+Class function TJSRelationalExpressionInstanceOf.OperatorToken: tjsToken;
+begin
+  Result:=tjsInstanceOf;
+end;
+
+Class Function TJSRelationalExpressionInstanceOf.AllowCompact: Boolean;
+begin
+  Result:=False;
+end;
+
+{ TJSRelationalExpressionIn }
+
+Class function TJSRelationalExpressionIn.OperatorToken: tjsToken;
+begin
+  Result:=tjsIn;
+end;
+
+Class Function TJSRelationalExpressionIn.AllowCompact: Boolean;
+begin
+  Result:=False;
+end;
+
+{ TJSRelationalExpressionGE }
+
+Class function TJSRelationalExpressionGE.OperatorToken: tjsToken;
+begin
+  Result:=tjsGE;
+end;
+
+{ TJSRelationalExpressionLE }
+
+Class function TJSRelationalExpressionLE.OperatorToken: tjsToken;
+begin
+  Result:=tjsLE;
+end;
+
+{ TJSRelationalExpressionGT }
+
+Class function TJSRelationalExpressionGT.OperatorToken: tjsToken;
+begin
+  Result:=tjsGT;
+end;
+
+{ TJSRelationalExpressionLT }
+
+Class function TJSRelationalExpressionLT.OperatorToken: tjsToken;
+begin
+  Result:=tjsLT;
+end;
+
+{ TJSEqualityExpressionSNE }
+
+Class function TJSEqualityExpressionSNE.OperatorToken: tjsToken;
+begin
+  Result:=tjsSNE;
+end;
+
+{ TJSEqualityExpressionSEQ }
+
+Class function TJSEqualityExpressionSEQ.OperatorToken: tjsToken;
+begin
+  Result:=tjsSEQ;
+end;
+
+{ TJSEqualityExpressionNE }
+
+Class function TJSEqualityExpressionNE.OperatorToken: tjsToken;
+begin
+  Result:=tjsNE;
+end;
+
+{ TJSEqualityExpressionEQ }
+
+Class function TJSEqualityExpressionEQ.OperatorToken: tjsToken;
+begin
+  Result:=tjsEQ;
+end;
+
+{ TJSBinaryExpression }
+
+Class function TJSBinaryExpression.OperatorToken: tjsToken;
+begin
+  Result:=tjsUnknown
+end;
+
+Class function TJSBinaryExpression.OperatorString: string;
+
+Var
+  T : TJSToken;
+begin
+  T:=OperatorToken;
+  if (T<>tjsUnknown) then
+    begin
+    Result:=TokenInfos[T]
+    end
+  else
+    Result:='';
+end;
+
+Class Function TJSBinaryExpression.AllowCompact: Boolean;
+begin
+  Result:=True
+end;
+
+{ TJSBitwiseXOrExpression }
+
+Class function TJSBitwiseXOrExpression.OperatorToken : tjsToken;
+begin
+  Result:=tjsXor
+end;
+
+{ TJSBitwiseOrExpression }
+
+Class function TJSBitwiseOrExpression.OperatorToken : tjsToken;
+begin
+  Result:=tjsOr
+end;
+
+{ TJSBitwiseAndExpression }
+
+Class function TJSBitwiseAndExpression.OperatorToken : tjsToken;
+begin
+  Result:=tjsAnd
+end;
+
+{ TJSLogicalAndExpression }
+
+Class function TJSLogicalAndExpression.OperatorToken : tjsToken;
+begin
+  Result:=tjsAndAnd
+end;
+
+{ TJSLogicalOrExpression }
+
+Class function TJSLogicalOrExpression.OperatorToken : tjsToken;
+begin
+  Result:=tjsOrOr
+end;
+
+{ TJSUnaryVoidExpression }
+
+Class function TJSUnaryVoidExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsvoid;
+end;
+
+{ TJSThrowStatement }
+
+Class function TJSThrowStatement.PrefixOperatorToken: tjsToken;
+begin
+  Result:=tjsThrow;
+end;
+
+{ TJSUnaryPostMinusMinusExpression }
+
+Class function TJSUnaryPostMinusMinusExpression.PostFixOperatorToken : tjsToken;
+begin
+  Result:=tjsMinusMinus;
+end;
+
+{ TJSUnaryPostPlusPlusExpression }
+
+Class function TJSUnaryPostPlusPlusExpression.PostFixOperatorToken : tjsToken;
+begin
+  Result:=tjsPlusPlus;
+end;
+
+{ TJSUnaryNotExpression }
+
+Class function TJSUnaryNotExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsNot;
+end;
+
+{ TJSUnaryInvExpression }
+
+Class function TJSUnaryInvExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsinv;
+end;
+
+{ TJSUnaryMinusExpression }
+
+Class function TJSUnaryMinusExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsMinus;
+end;
+
+{ TJSUnaryPlusExpression }
+
+Class function TJSUnaryPlusExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsPlus;
+end;
+
+{ TJSUnaryPreMinusMinusExpression }
+
+Class function TJSUnaryPreMinusMinusExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsMinusMinus;
+end;
+
+{ TJSUnaryPrePlusPlusExpression }
+
+Class function TJSUnaryPrePlusPlusExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsPlusPlus;
+end;
+
+{ TJSUnaryTypeOfExpression }
+
+Class function TJSUnaryTypeOfExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsTypeOf;
+end;
+
+{ TJSUnaryDeleteExpression }
+
+Class function TJSUnaryDeleteExpression.PrefixOperatorToken : tjsToken;
+begin
+  Result:=tjsdelete;
+end;
+
+{ TJSElement }
+
+constructor TJSElement.Create(ALine, AColumn: Integer; const ASource: String);
+begin
+  FLine:=ALine;
+  FColumn:=AColumn;
+  FSource:=ASource;
+end;
+
+procedure TJSElement.AssignPosition(El: TJSElement);
+begin
+  Source:=El.Source;
+  Line:=El.Line;
+  Column:=El.Column;
+end;
+
+{ TJSRegularExpressionLiteral }
+
+function TJSRegularExpressionLiteral.GetA(AIndex : integer): TJSValue;
+begin
+  Result:=FArgv[AIndex];
+end;
+
+procedure TJSRegularExpressionLiteral.SetA(AIndex : integer;
+  const AValue: TJSValue);
+begin
+  FArgv[AIndex]:=Avalue;
+end;
+
+constructor TJSRegularExpressionLiteral.Create(ALine, AColumn: Integer;
+  const ASource: String);
+begin
+  inherited Create(ALine, AColumn, ASource);
+  FPattern:=TJSValue.Create;
+  FPatternFlags:=TJSValue.Create;
+end;
+
+destructor TJSRegularExpressionLiteral.Destroy;
+begin
+  FreeAndNil(FPattern);
+  FreeAndNil(FPatternFlags);
+  Inherited Destroy;
+end;
+
+{ TJSArrayLiteralElements }
+
+function TJSArrayLiteralElements.GetE(AIndex : Integer): TJSArrayLiteralElement;
+begin
+  Result:=TJSArrayLiteralElement(Items[AIndex]);
+end;
+
+function TJSArrayLiteralElements.AddElement: TJSArrayLiteralElement;
+begin
+  Result:=TJSArrayLiteralElement(Add);
+end;
+
+{ TJSArrayLiteral }
+
+constructor TJSArrayLiteral.Create(ALine, AColumn: Integer; const ASource: String);
+begin
+  inherited Create(ALine, AColumn, ASource);
+  FElements:=TJSArrayLiteralElements.Create(TJSArrayLiteralElement);
+end;
+
+procedure TJSArrayLiteral.AddElement(El: TJSElement);
+var
+  ArrEl: TJSArrayLiteralElement;
+begin
+  ArrEl:=Elements.AddElement;
+  ArrEl.ElementIndex:=Elements.Count-1;
+  ArrEl.Expr:=El;
+end;
+
+destructor TJSArrayLiteral.Destroy;
+begin
+  FreeAndNil(FElements);
+  inherited Destroy;
+end;
+
+{ TJSObjectLiteralElements }
+
+function TJSObjectLiteralElements.GetE(AIndex : Integer
+  ): TJSObjectLiteralElement;
+begin
+  Result:=TJSObjectLiteralElement(Items[AIndex]);
+end;
+
+
+function TJSObjectLiteralElements.AddElement: TJSObjectLiteralElement;
+begin
+  Result:=TJSObjectLiteralElement(Add);
+end;
+
+{ TJSObjectLiteral }
+
+constructor TJSObjectLiteral.Create(ALine, AColumn: Integer; const ASource: String = '');
+begin
+  inherited Create(ALine, AColumn, ASource);
+  FElements:=TJSObjectLiteralElements.Create(TJSObjectLiteralElement);
+end;
+
+destructor TJSObjectLiteral.Destroy;
+begin
+  FreeAndNil(FElements);
+  inherited Destroy;
+end;
+
+{ TJSObjectLiteralElement }
+
+destructor TJSObjectLiteralElement.Destroy;
+begin
+  FreeAndNil(Fexpr);
+  inherited Destroy;
+end;
+
+{ TJSArrayLiteralElement }
+
+destructor TJSArrayLiteralElement.Destroy;
+begin
+  FreeAndNil(FExpr);
+  inherited Destroy;
+end;
+
+{ TJSNewMemberExpression }
+
+destructor TJSNewMemberExpression.Destroy;
+begin
+  FreeAndNil(FArgs);
+  inherited Destroy;
+end;
+
+procedure TJSNewMemberExpression.AddArg(El: TJSElement);
+begin
+  if Args=nil then
+    Args:=TJSArguments.Create(Line,Column,Source);
+  Args.Elements.AddElement.Expr:=El;
+end;
+
+{ TJSMemberExpression }
+
+destructor TJSMemberExpression.Destroy;
+begin
+  FreeAndNil(FMExpr);
+  inherited Destroy;
+end;
+
+{ TJSCallExpression }
+
+destructor TJSCallExpression.Destroy;
+begin
+  FreeAndNil(FExpr);
+  FreeAndNil(FArgs);
+  inherited Destroy;
+end;
+
+procedure TJSCallExpression.AddArg(El: TJSElement);
+begin
+  Args.Elements.AddElement.Expr:=El;
+end;
+
+{ TJSUnary }
+
+Class function TJSUnary.PrefixOperatorToken: tjsToken;
+begin
+  Result:=tjsUnknown;
+end;
+
+Class function TJSUnary.PostFixOperatorToken: tjsToken;
+begin
+  Result:=tjsUnknown;
+end;
+
+Class function TJSUnary.PrefixOperator: String;
+
+Var
+  T : TJSToken;
+
+begin
+  T:=PrefixOperatorToken;
+  if (T=tjsUnknown) then
+    Result:=''
+  else
+    begin
+    Result:=TokenInfos[t];
+    if t in [tjsTypeOf,tjsVoid,tjsDelete,tjsThrow] then
+      Result:=Result+' ';
+    end;
+end;
+
+Class function TJSUnary.PostFixOperator: String;
+
+Var
+  T : TJSToken;
+
+begin
+  T:=PostFixOperatorToken;
+  if (T=tjsUnknown) then
+    Result:=''
+  else
+    Result:=TokenInfos[t];
+end;
+
+Destructor TJSUnary.Destroy;
+begin
+  FreeAndNil(FA);
+  inherited Destroy;
+end;
+
+{ TJSBinary }
+
+destructor TJSBinary.Destroy;
+begin
+  FreeAndNil(FB);
+  FreeAndNil(FA);
+  inherited Destroy;
+end;
+
+{ TJSConditionalExpression }
+
+destructor TJSConditionalExpression.Destroy;
+begin
+  FreeAndNil(FB);
+  FreeAndNil(FA);
+  FreeAndNil(FC);
+  inherited Destroy;
+end;
+
+{ TJSAssign }
+
+Destructor TJSAssignStatement.Destroy;
+begin
+  FreeAndNil(FLHS);
+  FreeAndNil(FExpr);
+  inherited Destroy;
+end;
+
+Class function TJSAssignStatement.OperatorToken: tjsToken;
+begin
+  Result:=tjsUNknown;
+end;
+
+Class function TJSAssignStatement.OperatorString: String;
+
+Var
+  t :  TJSToken;
+begin
+  T:=OperatorToken;
+  if (tjsUNknown<>t) then
+    Result:=TokenInfos[t]
+  else
+    Result:='';
+end;
+
+{ TJSVarDeclaration }
+
+
+destructor TJSVarDeclaration.Destroy;
+begin
+  FreeAndNil(FInit);
+  inherited Destroy;
+end;
+
+{ TJSIfStatement }
+
+destructor TJSIfStatement.Destroy;
+begin
+  FreeAndNil(FCond);
+  FreeAndNil(FBTrue);
+  FreeAndNil(FBFalse);
+  inherited Destroy;
+end;
+
+{ TJSBodyStatement }
+
+destructor TJSBodyStatement.Destroy;
+begin
+  FreeAndNil(FBody);
+  inherited Destroy;
+end;
+
+{ TJSCondLoopStatement }
+
+destructor TJSCondLoopStatement.Destroy;
+begin
+  FreeAndNil(FCond);
+  inherited Destroy;
+end;
+
+{ TJSForStatement }
+
+destructor TJSForStatement.Destroy;
+begin
+  FreeAndNil(FIncr);
+  FreeAndNil(FInit);
+  inherited Destroy;
+end;
+
+{ TJSForInStatement }
+
+destructor TJSForInStatement.Destroy;
+begin
+  FreeAndNil(FList);
+  FreeAndNil(FLHS);
+  inherited Destroy;
+end;
+
+
+{ TJSReturn }
+
+destructor TJSReturnStatement.Destroy;
+begin
+  FreeAndNil(FExpr);
+  inherited Destroy;
+end;
+
+{ TJSCaseElement }
+
+destructor TJSCaseElement.Destroy;
+begin
+  FreeAndNil(FExpr);
+  FreeAndNil(FBody);
+  inherited Destroy;
+end;
+
+{ TJSSwitch }
+
+constructor TJSSwitchStatement.Create(ALine, AColumn: Integer; const ASource: String);
+begin
+  inherited Create(ALine, AColumn, ASource);
+  FCases:=TJSCaseElements.Create(TJSCaseElement);
+end;
+
+destructor TJSSwitchStatement.Destroy;
+begin
+  FreeAndNil(FCases);
+  FreeAndNil(FCond);
+  inherited Destroy;
+end;
+
+{ TJSCaseElements }
+
+function TJSCaseElements.GetC(AIndex : Integer): TJSCaseElement;
+begin
+  Result:=TJSCaseElement(Items[AIndex]);
+end;
+
+
+function TJSCaseElements.AddCase: TJSCaseElement;
+begin
+  Result:=TJSCaseElement(Add);
+end;
+
+{ TJSTryStatement }
+
+destructor TJSTryStatement.Destroy;
+begin
+  FreeAndNil(FBlock);
+  FreeAndNil(FBCatch);
+  FreeAndNil(FBFinally);
+  inherited Destroy;
+end;
+
+{ TJSSourceElements }
+
+constructor TJSSourceElements.Create(ALine, AColumn: Integer; const ASource: String
+  );
+begin
+  inherited Create(ALine, AColumn, ASource);
+  FStatements:=TJSElementNodes.Create(TJSElementNode);
+  FFunctions:=TJSElementNodes.Create(TJSElementNode);
+  FVars:=TJSElementNodes.Create(TJSElementNode);
+end;
+
+destructor TJSSourceElements.Destroy;
+
+Var
+  i : integer;
+
+begin
+  FreeAndNil(FStatements);
+  FreeAndNil(FFunctions);
+  // Vars are owned by their statements, and those have been freed
+  For I:=0 to FVars.Count-1 do
+    FVars.Nodes[i].Node:=nil;
+  FreeAndNil(FVars);
+  inherited Destroy;
+end;
+
+{ TJSElementNodes }
+
+function TJSElementNodes.GetN(AIndex : Integer): TJSElementNode;
+begin
+  Result:=TJSElementNode(Items[Aindex])
+end;
+
+function TJSElementNodes.AddNode: TJSElementNode;
+begin
+  Result:=TJSElementNode(Add);
+end;
+
+{ TJSFunction }
+
+destructor TJSFunctionDeclarationStatement.Destroy;
+begin
+  FreeAndNil(FFuncDef);
+  inherited Destroy;
+end;
+
+{ TJSElementNode }
+
+destructor TJSElementNode.Destroy;
+begin
+  FreeAndNil(FNode);
+  inherited Destroy;
+end;
+
+{ TJSFuncDef }
+
+procedure TJSFuncDef.SetParams(const AValue: TStrings);
+begin
+  if FParams=AValue then exit;
+  FParams.Assign(AValue);
+end;
+
+constructor TJSFuncDef.Create;
+begin
+  FParams:=TStringList.Create;
+end;
+
+destructor TJSFuncDef.Destroy;
+begin
+  FreeAndNil(FBody);
+  FreeAndNil(FParams);
+  inherited Destroy;
+end;
+
+{ TJSBracketMemberExpression }
+
+destructor TJSBracketMemberExpression.Destroy;
+begin
+  FreeAndNil(FName);
+  inherited Destroy;
+end;
+
+{ TJSLiteral }
+
+constructor TJSLiteral.Create(ALine, AColumn: Integer; const ASource: String);
+begin
+  FValue:=TJSValue.Create;
+  inherited Create(ALine, AColumn, ASource);
+end;
+
+destructor TJSLiteral.Destroy;
+begin
+  FreeAndNil(FValue);
+  Inherited;
+end;
+
+end.
+

+ 2104 - 0
compiler/packages/fcl-js/src/jswriter.pp

@@ -0,0 +1,2104 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+                   
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+                                
+  **********************************************************************}
+unit jswriter;
+
+{$mode objfpc}{$H+}
+{ $DEFINE DEBUGJSWRITER}
+{AllowWriteln}
+
+{$if defined(fpc) or defined(NodeJS)}
+  {$define HasFileWriter}
+{$endif}
+
+interface
+
+uses
+  {$ifdef pas2js}
+  JS,
+  {$endif}
+  SysUtils, jsbase, jstree;
+
+Type
+  {$ifdef pas2js}
+  TJSWriterString = UnicodeString;
+  TJSWriterChar = WideChar;
+  {$else}
+  TJSWriterString = AnsiString;
+  TJSWriterChar = AnsiChar;
+  {$endif}
+
+  TTextWriter = class;
+
+  TTextWriterWriting = procedure(Sender: TTextWriter) of object;
+
+  { TTextWriter }
+
+  TTextWriter = Class(TObject)
+  private
+    FCurElement: TJSElement;
+    FCurLine: integer;
+    FCurColumn: integer;
+    FOnWriting: TTextWriterWriting;
+  protected
+    Function DoWrite(Const S : TJSWriterString) : Integer; virtual; abstract;
+    {$ifdef FPC_HAS_CPSTRING}
+    Function DoWrite(Const S : UnicodeString) : Integer; virtual; abstract;
+    {$endif}
+    procedure SetCurElement(const AValue: TJSElement); virtual;
+    Procedure Writing; virtual; // called before adding new characters
+  Public
+    // All functions return the number of bytes copied to output stream.
+    constructor Create;
+    {$ifdef FPC_HAS_CPSTRING}
+    Function Write(Const S : UnicodeString) : Integer;
+    {$endif}
+    Function Write(Const S : TJSWriterString) : Integer;
+    Function WriteLn(Const S : TJSWriterString) : Integer;
+    Function Write(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function WriteLn(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function Write(Const Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Function WriteLn(Const Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif}) : Integer;
+    Property CurLine: integer read FCurLine write FCurLine;
+    Property CurColumn: integer read FCurColumn write FCurColumn;// char index, not codepoint
+    Property CurElement: TJSElement read FCurElement write SetCurElement;
+    Property OnWriting: TTextWriterWriting read FOnWriting write FOnWriting;
+  end;
+
+  {$ifdef HasFileWriter}
+  { TFileWriter }
+
+  TFileWriter = Class(TTextWriter)
+  Protected
+    {$ifdef NodeJS}
+    {$else}
+    FFile : Text;
+    {$endif}
+    FFileName : String;
+    Function DoWrite(Const S : TJSWriterString) : Integer; override;
+    {$ifdef FPC_HAS_CPSTRING}
+    Function DoWrite(Const S : UnicodeString) : Integer; override;
+    {$endif}
+  Public
+    Constructor Create(Const AFileName : String); reintroduce;
+    Destructor Destroy; override;
+    Procedure Flush;
+    Procedure Close;
+    Property FileName : String Read FFileName;
+  end;
+  {$endif}
+
+  TBufferWriter_Buffer = Array of {$ifdef fpc}byte{$else}string{$endif};
+
+  { TBufferWriter }
+
+  TBufferWriter = Class(TTextWriter)
+  private type
+    TBuffer = TBufferWriter_Buffer;
+  private
+    FBufPos,
+    FCapacity: Cardinal;
+    FBuffer: TBuffer;
+    function GetAsString: TJSWriterString;
+    {$ifdef fpc}
+    function GetBuffer: Pointer;
+    {$endif}
+    function GetBufferLength: Integer;
+    function GetCapacity: Cardinal;
+    {$ifdef FPC_HAS_CPSTRING}
+    function GetUnicodeString: UnicodeString;
+    {$endif}
+    procedure SetAsString(const AValue: TJSWriterString);
+    procedure SetCapacity(AValue: Cardinal);
+  Protected
+    Function DoWrite(Const S : TJSWriterString) : integer; override;
+    {$ifdef FPC_HAS_CPSTRING}
+    Function DoWrite(Const S : UnicodeString) : integer; override;
+    {$endif}
+  Public
+    Constructor Create(Const ACapacity : Cardinal); reintroduce;
+    {$ifdef fpc}
+    Procedure SaveToFile(Const AFileName : String);
+    Property Buffer : Pointer Read GetBuffer;
+    {$endif}
+    {$ifdef pas2js}
+    Property Buffer: TBufferWriter_Buffer read FBuffer;
+    {$endif}
+    Property BufferLength : Integer Read GetBufferLength;
+    Property Capacity : Cardinal Read GetCapacity Write SetCapacity;
+    Property AsString : TJSWriterString Read GetAsString Write SetAsString;
+    {$ifdef FPC_HAS_CPSTRING}
+    Property AsAnsiString : AnsiString Read GetAsString; deprecated 'use AsString instead, fpc 3.3.1';
+    Property AsUnicodeString : UnicodeString Read GetUnicodeString;
+    {$endif}
+  end;
+
+  TJSEscapeQuote = (
+    jseqSingle,
+    jseqDouble,
+    jseqBoth
+    );
+
+  { TJSWriter }
+
+  TWriteOption = (woCompact,
+                  {$ifdef FPC_HAS_CPSTRING}
+                  woUseUTF8,
+                  {$endif}
+                  woTabIndent,
+                  woEmptyStatementAsComment,
+                  woQuoteElementNames,
+                  woCompactArrayLiterals,
+                  woCompactObjectLiterals,
+                  woCompactArguments);
+  TWriteOptions = Set of TWriteOption;
+
+  TJSWriter = Class
+  private
+    FCurIndent : Integer;
+    FFreeWriter : Boolean;
+    FIndentChar : Char;
+    FIndentSize: Byte;
+    FLastChar: WideChar;
+    FLinePos : Integer;
+    FOptions: TWriteOptions;
+    FSkipCurlyBrackets : Boolean;
+    FSkipRoundBrackets : Boolean;
+    FWriter: TTextWriter;
+    function GetUseUTF8: Boolean;
+    procedure SetOptions(AValue: TWriteOptions);
+  Protected
+    // Helper routines
+    Procedure Error(Const Msg : TJSWriterString);
+    Procedure Error(Const Fmt : TJSWriterString; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
+    Procedure WriteIndent; // inline;
+    {$ifdef FPC_HAS_CPSTRING}
+    Procedure Write(Const U : UnicodeString);
+    {$endif}
+    Procedure Write(Const S : TJSWriterString);
+    Procedure WriteLn(Const S : TJSWriterString);
+    {$ifdef FPC_HAS_CPSTRING}
+    Procedure WriteLn(Const U : UnicodeString);
+    {$endif}
+    // one per type of statement
+    Procedure WriteValue(V : TJSValue);  virtual;
+    Procedure WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral);
+    Procedure WriteVariableStatement(El: TJSVariableStatement);
+    Procedure WriteEmptyBlockStatement(El: TJSEmptyBlockStatement); virtual;
+    Procedure WriteEmptyStatement(El: TJSEmptyStatement);virtual;
+    Procedure WriteLiteral(El: TJSLiteral);virtual;
+    Procedure WriteArrayLiteral(El: TJSArrayLiteral);virtual;
+    Procedure WriteObjectLiteral(El: TJSObjectLiteral);virtual;
+    Procedure WriteMemberExpression(El: TJSMemberExpression);virtual;
+    Procedure WriteCallExpression(El: TJSCallExpression);virtual;
+    Procedure WriteSwitchStatement(El: TJSSwitchStatement);virtual;
+    Procedure WriteUnary(El: TJSUnary);virtual;
+    Procedure WriteAssignStatement(El: TJSAssignStatement);virtual;
+    Procedure WriteForInStatement(El: TJSForInStatement);virtual;
+    Procedure WriteWhileStatement(El: TJSWhileStatement);virtual;
+    Procedure WriteForStatement(El: TJSForStatement);virtual;
+    Procedure WriteIfStatement(El: TJSIfStatement);virtual;
+    Procedure WriteSourceElements(El: TJSSourceElements);virtual;
+    Procedure WriteStatementList(El: TJSStatementList);virtual;
+    Procedure WriteTryStatement(El: TJSTryStatement);virtual;
+    Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual;
+    Procedure WriteWithStatement(El: TJSWithStatement);virtual;
+    Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual;
+    Procedure WriteConditionalExpression(El: TJSConditionalExpression);virtual;
+    Procedure WriteFunctionBody(El: TJSFunctionBody);virtual;
+    Procedure WriteFunctionDeclarationStatement(El: TJSFunctionDeclarationStatement);virtual;
+    Procedure WriteLabeledStatement(El: TJSLabeledStatement);virtual;
+    Procedure WriteReturnStatement(El: TJSReturnStatement);virtual;
+    Procedure WriteTargetStatement(El: TJSTargetStatement);virtual;
+    Procedure WriteFuncDef(FD: TJSFuncDef);virtual;
+    Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual;
+    Procedure WriteBinary(El: TJSBinary);virtual;
+    Function IsEmptyStatement(El: TJSElement): boolean;
+    Function HasLineEnding(El: TJSElement): boolean;
+  Public
+    Function EscapeString(const S: TJSString; Quote: TJSEscapeQuote = jseqDouble): TJSString;
+    Constructor Create(AWriter : TTextWriter);
+    {$ifdef HasFileWriter}
+    Constructor Create(Const AFileName : String);
+    {$endif}
+    Destructor Destroy; override;
+    Procedure WriteJS(El : TJSElement);
+    Procedure Indent;
+    Procedure Undent;
+    Property Writer : TTextWriter Read FWriter;
+    Property Options : TWriteOptions Read FOptions Write SetOptions;
+    Property IndentSize : Byte Read FIndentSize Write FIndentSize;
+    Property UseUTF8 : Boolean Read GetUseUTF8;
+    property LastChar: WideChar read FLastChar;
+  end;
+  EJSWriter = Class(Exception);
+
+{$ifdef FPC_HAS_CPSTRING}
+Function UTF16ToUTF8(const S: UnicodeString): string;
+{$endif}
+Function QuoteJSString(const S: TJSString; Quote: TJSChar = #0): TJSString;
+
+implementation
+
+Resourcestring
+  SErrUnknownJSClass = 'Unknown javascript element class : %s';
+  SErrNilNode = 'Nil node in Javascript';
+
+{$ifdef FPC_HAS_CPSTRING}
+function HexDump(p: PChar; Count: integer): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to Count-1 do
+    Result:=Result+HexStr(ord(p[i]),2);
+end;
+
+function UTF16ToUTF8(const S: UnicodeString): string;
+begin
+  Result:=UTF8Encode(S);
+  // prevent UTF8 codepage appear in the strings - we don't need codepage
+  // conversion magic
+  SetCodePage(RawByteString(Result), CP_ACP, False);
+end;
+{$endif}
+
+function QuoteJSString(const S: TJSString; Quote: TJSChar): TJSString;
+var
+  i, j, Count: Integer;
+begin
+  if Quote=#0 then
+    begin
+    if Pos('"',S)>0 then
+      Quote:=''''
+    else
+      Quote:='"';
+    end;
+  Result := '' + Quote;
+  Count := length(S);
+  i := 0;
+  j := 0;
+  while i < Count do
+    begin
+    inc(i);
+    if S[i] = Quote then
+      begin
+      Result := Result + copy(S, 1 + j, i - j) + Quote;
+      j := i;
+      end;
+    end;
+  if i <> j then
+    Result := Result + copy(S, 1 + j, i - j);
+  Result := Result + Quote;
+end;
+
+{ TBufferWriter }
+
+function TBufferWriter.GetBufferLength: Integer;
+begin
+  Result:=FBufPos;
+end;
+
+function TBufferWriter.GetAsString: TJSWriterString;
+begin
+  {$ifdef pas2js}
+  if FBufPos<length(FBuffer) then
+    TJSArray(FBuffer).Length:=FBufPos;
+  Result:=TJSArray(FBuffer).join('');
+  {$else}
+  Result:='';
+  SetLength(Result,BufferLength);
+  if (BufferLength>0) then
+    Move(FBuffer[0],Result[1],BufferLength);
+  {$endif}
+end;
+
+{$ifdef fpc}
+function TBufferWriter.GetBuffer: Pointer;
+begin
+  Result:=Pointer(FBuffer);
+end;
+{$endif}
+
+function TBufferWriter.GetCapacity: Cardinal;
+begin
+  Result:=Length(FBuffer);
+end;
+
+{$ifdef FPC_HAS_CPSTRING}
+function TBufferWriter.GetUnicodeString: UnicodeString;
+
+Var
+  SL : Integer;
+
+begin
+  SL:=BufferLength div SizeOf(UnicodeChar); // Silently ignores last byte
+  Result:='';
+  SetLength(Result,SL);
+  if (SL>0) then
+    Move(FBuffer[0],Result[1],SL*SizeOf(UnicodeChar));
+end;
+{$endif}
+
+procedure TBufferWriter.SetAsString(const AValue: TJSWriterString);
+begin
+  {$ifdef pas2js}
+  SetLength(FBuffer,0);
+  FCapacity:=0;
+  {$endif}
+  FBufPos:=0;
+  DoWrite(AValue);
+end;
+
+procedure TBufferWriter.SetCapacity(AValue: Cardinal);
+begin
+  if FCapacity=AValue then Exit;
+  SetLength(FBuffer,AValue);
+  if (FBufPos>Capacity) then
+    FBufPos:=Capacity;
+end;
+
+function TBufferWriter.DoWrite(const S: TJSWriterString): integer;
+{$ifdef pas2js}
+begin
+  Result:=Length(S)*2;
+  if Result=0 then exit;
+  TJSArray(FBuffer).push(S);
+  inc(FBufPos);
+  FCapacity:=FBufPos;
+end;
+{$else}
+Var
+  DesLen,MinLen : Integer;
+
+begin
+  Result:=Length(S)*SizeOf(TJSWriterChar);
+  if Result=0 then exit;
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
+    begin
+    DesLen:=(FCapacity*3) div 2;
+    if DesLen>MinLen then
+      MinLen:=DesLen;
+    Capacity:=MinLen;
+    end;
+  Move(S[1],FBuffer[FBufPos],Result);
+  FBufPos:=integer(FBufPos)+Result;
+end;
+{$endif}
+
+{$ifdef FPC_HAS_CPSTRING}
+function TBufferWriter.DoWrite(const S: UnicodeString): integer;
+
+Var
+  DesLen,MinLen : Integer;
+
+begin
+  Result:=Length(S)*SizeOf(UnicodeChar);
+  if Result=0 then exit;
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
+    begin
+    DesLen:=(FCapacity*3) div 2;
+    if DesLen>MinLen then
+      MinLen:=DesLen;
+    Capacity:=MinLen;
+    end;
+  Move(S[1],FBuffer[FBufPos],Result);
+  FBufPos:=integer(FBufPos)+Result;
+end;
+{$endif}
+
+constructor TBufferWriter.Create(const ACapacity: Cardinal);
+begin
+  inherited Create;
+  Capacity:=ACapacity;
+end;
+
+{$ifdef fpc}
+procedure TBufferWriter.SaveToFile(const AFileName: String);
+Var
+  F : File;
+
+begin
+  Assign(F,AFileName);
+  Rewrite(F,1);
+  try
+    BlockWrite(F,FBuffer[0],FBufPos);
+  finally
+    Close(F);
+  end;
+end;
+{$endif}
+
+{ TJSWriter }
+
+procedure TJSWriter.SetOptions(AValue: TWriteOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+  If woTabIndent in FOptions then
+    FIndentChar:=#9
+  else
+    FIndentChar:=' ';
+end;
+
+function TJSWriter.GetUseUTF8: Boolean;
+begin
+  Result:={$ifdef FPC_HAS_CPSTRING}(woUseUTF8 in Options){$else}false{$endif};
+end;
+
+procedure TJSWriter.Error(const Msg: TJSWriterString);
+begin
+  Raise EJSWriter.Create(Msg);
+end;
+
+procedure TJSWriter.Error(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
+begin
+  Raise EJSWriter.CreateFmt(Fmt,Args);
+end;
+
+procedure TJSWriter.WriteIndent;
+
+begin
+  If (FLinePos=0) and (FCurIndent>0) then
+    begin
+    FLinePos:=Writer.Write(StringOfChar(FIndentChar,FCurIndent));
+    FLastChar:=WideChar(FIndentChar);
+    end;
+end;
+
+procedure TJSWriter.Indent;
+begin
+  Inc(FCurIndent,FIndentSIze);
+end;
+
+procedure TJSWriter.Undent;
+begin
+  if (FCurIndent>=FIndentSIze) then
+    Dec(FCurIndent,FIndentSIze)
+  else
+    FCurIndent:=0;
+end;
+
+{$ifdef FPC_HAS_CPSTRING}
+procedure TJSWriter.Write(const U: UnicodeString);
+
+Var
+  S : String;
+
+begin
+  //system.writeln('TJSWriter.Write unicodestring=',U);
+  WriteIndent;
+  if UseUTF8 then
+    begin
+    S:=UTF16ToUTF8(U);
+    if S='' then exit;
+    FLinePos:=FLinePos+Writer.Write(S);
+    FLastChar:=WideChar(S[length(S)]);
+    end
+  else if U<>'' then
+    begin
+    FLinePos:=FLinePos+Writer.Write(U);
+    FLastChar:=U[length(U)];
+    end;
+end;
+{$endif}
+
+procedure TJSWriter.Write(const S: TJSWriterString);
+begin
+  //system.writeln('TJSWriter.Write TJSWriterString=',S);
+  {$ifdef FPC_HAS_CPSTRING}
+  if Not (woUseUTF8 in Options) then
+    Write(UnicodeString(S))
+  else
+  {$endif}
+    begin
+    WriteIndent;
+    if s='' then exit;
+    FLinePos:=FLinePos+Writer.Write(S);
+    FLastChar:=WideChar(S[length(S)]);
+    end;
+end;
+
+procedure TJSWriter.WriteLn(const S: TJSWriterString);
+begin
+  {$ifdef FPC_HAS_CPSTRING}
+  if Not (woUseUTF8 in Options) then
+    Writeln(UnicodeString(S))
+  else
+  {$endif}
+    begin
+    WriteIndent;
+    Writer.WriteLn(S);
+    FLastChar:=WideChar(#10);
+    FLinePos:=0;
+    end;
+end;
+
+{$ifdef FPC_HAS_CPSTRING}
+procedure TJSWriter.WriteLn(const U: UnicodeString);
+Var
+  S : String;
+
+begin
+  if UseUTF8 then
+    begin
+    S:=UTF16ToUTF8(U);
+    Writeln(S);
+    end
+  else
+    begin
+    WriteIndent;
+    FLinePos:=FLinePos+Writer.Write(U);
+    Writer.WriteLn('');
+    FLastChar:=WideChar(#10);
+    FLinePos:=0;
+    end;
+end;
+{$endif}
+
+function TJSWriter.EscapeString(const S: TJSString; Quote: TJSEscapeQuote
+  ): TJSString;
+
+Var
+  I,J,L : Integer;
+  R: TJSString;
+  c: WideChar;
+begin
+  //system.writeln('TJSWriter.EscapeString "',S,'"');
+  I:=1;
+  J:=1;
+  R:='';
+  L:=Length(S);
+  While I<=L do
+    begin
+    c:=S[I];
+    if (c in [#0..#31,'"','''','/','\'])
+        or (c>=#$ff00) or ((c>=#$D800) and (c<=#$DFFF)) then
+      begin
+      R:=R+Copy(S,J,I-J);
+      Case c of
+        '\' : R:=R+'\\';
+        '/' : R:=R+'\/';
+        '"' : if Quote=jseqSingle then R:=R+'"' else R:=R+'\"';
+        '''': if Quote=jseqDouble then R:=R+'''' else R:=R+'\''';
+        #0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(c),2));
+        #8  : R:=R+'\b';
+        #9  : R:=R+'\t';
+        #10 : R:=R+'\n';
+        #12 : R:=R+'\f';
+        #13 : R:=R+'\r';
+        #$D800..#$DFFF:
+          begin
+          if (I<L) then
+            begin
+            c:=S[I+1];
+            if (c>=#$D000) and (c<=#$DFFF) then
+              begin
+              inc(I,2); // surrogate, two char codepoint
+              continue;
+              end
+            else
+              // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
+              R:=R+'\u'+TJSString(HexStr(ord(c),4));
+            end
+          else
+            // invalid UTF-16 at end of string, cannot be encoded as UTF-8 -> encode as hex
+            R:=R+'\u'+TJSString(HexStr(ord(c),4));
+          end;
+        #$FF00..#$FFFF: R:=R+'\u'+TJSString(HexStr(ord(c),4));
+      end;
+      J:=I+1;
+      end;
+    Inc(I);
+    end;
+  R:=R+Copy(S,J,I-1);
+  Result:=R;
+  //system.writeln('TJSWriter.EscapeString Result="',Result,'"');
+end;
+
+procedure TJSWriter.WriteValue(V: TJSValue);
+const
+  TabWidth = 4;
+
+  function GetLineIndent(const S: TJSString; var p: integer): integer;
+  var
+    h, l: integer;
+  begin
+    h:=p;
+    l:=length(S);
+    Result:=0;
+    while h<=l do
+      begin
+      case S[h] of
+      #9: Result:=Result+(TabWidth-Result mod TabWidth);
+      ' ': inc(Result);
+      else break;
+      end;
+      inc(h);
+      end;
+    p:=h;
+  end;
+
+  function SkipToNextLineStart(const S: TJSString; p: integer): integer;
+  var
+    l: Integer;
+  begin
+    l:=length(S);
+    while p<=l do
+      begin
+      case S[p] of
+      #10,#13:
+        begin
+        if (p<l) and (S[p+1] in [#10,#13]) and (S[p]<>S[p+1]) then
+          inc(p,2)
+        else
+          inc(p);
+        break;
+        end
+      else inc(p);
+      end;
+      end;
+    Result:=p;
+  end;
+
+Var
+  S , S2: String;
+  JS: TJSString;
+  p, StartP: Integer;
+  MinIndent, CurLineIndent, j, Exp, Code: Integer;
+  i: SizeInt;
+  D, AsNumber: TJSNumber;
+begin
+  if V.CustomValue<>'' then
+    begin
+    JS:=V.CustomValue;
+    if JS='' then exit;
+
+    p:=SkipToNextLineStart(JS,1);
+    if p>length(JS) then
+      begin
+      // simple value
+      Write(JS);
+      exit;
+      end;
+
+    // multi line value
+
+    // find minimum indent
+    MinIndent:=-1;
+    repeat
+      CurLineIndent:=GetLineIndent(JS,p);
+      if (MinIndent<0) or (MinIndent>CurLineIndent) then
+        MinIndent:=CurLineIndent;
+      p:=SkipToNextLineStart(JS,p);
+    until p>length(JS);
+
+    // write value lines indented
+    p:=1;
+    GetLineIndent(JS,p); // the first line is already indented, skip
+    repeat
+      StartP:=p;
+      p:=SkipToNextLineStart(JS,StartP);
+      Write(copy(JS,StartP,p-StartP));
+      if p>length(JS) then break;
+      CurLineIndent:=GetLineIndent(JS,p);
+      Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent));
+    until false;
+
+    exit;
+    end;
+  Case V.ValueType of
+    jstUNDEFINED : S:='undefined';
+    jstNull : s:='null';
+    jstBoolean : if V.AsBoolean then s:='true' else s:='false';
+    jstString :
+      begin
+      JS:=V.AsString;
+      if Pos('"',JS)>0 then
+        JS:=''''+EscapeString(JS,jseqSingle)+''''
+      else
+        JS:='"'+EscapeString(JS,jseqDouble)+'"';
+      Write(JS);
+      exit;
+      end;
+    jstNumber :
+      begin
+      AsNumber:=V.AsNumber;
+      if (Frac(AsNumber)=0)
+          and (AsNumber>=double(MinSafeIntDouble))
+          and (AsNumber<=double(MaxSafeIntDouble)) then
+        begin
+        Str(Round(AsNumber),S);
+        end
+      else
+        begin
+        Str(AsNumber,S);
+        if S[1]=' ' then Delete(S,1,1);
+        i:=Pos('E',S);
+        if (i>2) then
+          begin
+          j:=i-2;
+          case s[j] of
+          '0':
+            begin
+            // check for 1.2340000000000001E...
+            while (j>1) and (s[j]='0') do dec(j);
+            if s[j]='.' then inc(j);
+            S2:=LeftStr(S,j)+copy(S,i,length(S));
+            val(S2,D,Code);
+            if (Code=0) and (D=AsNumber) then
+              S:=S2;
+            end;
+          '9':
+            begin
+            // check for 1.234999999999991E...
+            while (j>1) and (s[j]='9') do dec(j);
+            // cut '99999'
+            S2:=LeftStr(S,j)+copy(S,i,length(S));
+            if S[j]='.' then
+              Insert('0',S2,j+1);
+            // increment, e.g. 1.2999 -> 1.3
+            repeat
+              case S2[j] of
+              '0'..'8':
+                begin
+                S2[j]:=chr(ord(S2[j])+1);
+                break;
+                end;
+              '9':
+                S2[j]:='0';
+              '.': ;
+              end;
+              dec(j);
+              if (j=0) or not (S2[j] in ['0'..'9','.']) then
+                begin
+                // e.g. -9.999 became 0.0
+                val(copy(S,i+1,length(S)),Exp,Code);
+                if Code=0 then
+                  begin
+                  S2:='1E'+IntToStr(Exp+1);
+                  if S[1]='-' then
+                    S2:='-'+S2;
+                  end;
+                break;
+                end;
+            until false;
+            val(S2,D,Code);
+            if (Code=0) and (D=AsNumber) then
+              S:=S2;
+            end;
+          end;
+          end;
+        // chomp default exponent E+000
+        i:=Pos('E',S);
+        if i>0 then
+          begin
+          val(copy(S,i+1,length(S)),Exp,Code);
+          if Code=0 then
+            begin
+            if Exp=0 then
+              // 1.1E+000 -> 1.1
+              Delete(S,i,length(S))
+            else if (Exp>=-6) and (Exp<=6) then
+              begin
+              // small exponent -> use notation without E
+              Delete(S,i,length(S));
+              j:=Pos('.',S);
+              if j>0 then
+                Delete(S,j,1)
+              else
+                begin
+                j:=1;
+                while not (S[j] in ['0'..'9']) do inc(j);
+                end;
+              if Exp<0 then
+                begin
+                // e.g. -1.2  E-1
+                while Exp<0 do
+                  begin
+                  if (j>1) and (S[j-1] in ['0'..'9']) then
+                    dec(j)
+                  else
+                    Insert('0',S,j);
+                  inc(Exp);
+                  end;
+                Insert('.',S,j);
+                if (j=1) or not (S[j-1] in ['0'..'9']) then
+                  Insert('0',S,j);
+                if S[length(S)]='0' then
+                  Delete(S,length(S),1);
+                end
+              else
+                begin
+                // e.g. -1.2  E1
+                while Exp>0 do
+                  begin
+                  if (j<=length(S)) and (S[j] in ['0'..'9']) then
+                    inc(j)
+                  else
+                    Insert('0',S,j);
+                  dec(Exp);
+                  end;
+                if j<=length(S) then
+                  Insert('.',S,j);
+                end;
+              end
+            else
+              begin
+              // e.g. 1.1E+0010  -> 1.1E10
+              S:=LeftStr(S,i)+IntToStr(Exp);
+              if (i >= 4) and (s[i-1] = '0') and (s[i-2] = '.') then
+                // e.g. 1.0E22 -> 1E22
+                Delete(S, i-2, 2);
+              end
+            end;
+          end;
+        end;
+      end;
+    jstObject : ;
+    jstReference : ;
+    jstCompletion : ;
+  end;
+  if S='' then exit;
+  case S[1] of
+  '+': if FLastChar='+' then Write(' ');
+  '-': if FLastChar='-' then Write(' ');
+  end;
+  Write(S);
+end;
+
+constructor TJSWriter.Create(AWriter: TTextWriter);
+begin
+  FWriter:=AWriter;
+  FIndentChar:=' ';
+  FOptions:=[{$ifdef FPC_HAS_CPSTRING}woUseUTF8{$endif}];
+end;
+
+{$ifdef HasFileWriter}
+constructor TJSWriter.Create(const AFileName: String);
+begin
+  Create(TFileWriter.Create(AFileName));
+  FFreeWriter:=True;
+end;
+{$endif}
+
+destructor TJSWriter.Destroy;
+begin
+  If FFreeWriter then
+    begin
+    FWriter.Free;
+    FWriter:=Nil;
+    end;
+  inherited Destroy;
+end;
+
+procedure TJSWriter.WriteFuncDef(FD: TJSFuncDef);
+
+Var
+  C : Boolean;
+  I : Integer;
+  A, LastEl: TJSElement;
+
+begin
+  LastEl:=Writer.CurElement;
+  C:=(woCompact in Options);
+  Write('function ');
+  If (FD.Name<>'') then
+    Write(FD.Name);
+  Write('(');
+  if Assigned(FD.Params) then
+    For I:=0 to FD.Params.Count-1 do
+      begin
+      write(FD.Params[i]);
+      if I<FD.Params.Count-1 then
+        if C then Write(',') else Write (', ');
+      end;
+  Write(') {');
+  if Not (C or FD.IsEmpty) then
+    begin
+    Writeln('');
+    Indent;
+    end;
+  if Assigned(FD.Body) then
+    begin
+    FSkipCurlyBrackets:=True;
+    //writeln('TJSWriter.WriteFuncDef '+FD.Body.ClassName);
+    WriteJS(FD.Body);
+    A:=FD.Body.A;
+    If (Assigned(A))
+        and (not (A is TJSStatementList))
+        and (not (A is TJSSourceElements))
+        and (not (A is TJSEmptyBlockStatement))
+    then
+      if C then
+        Write('; ')
+      else
+        Writeln(';');
+    end;
+  Writer.CurElement:=LastEl;
+  if C then
+    Write('}')
+  else
+    begin
+    Undent;
+    Write('}'); // do not writeln
+    end;
+end;
+
+procedure TJSWriter.WriteEmptyBlockStatement(El: TJSEmptyBlockStatement);
+begin
+  if El=nil then ;
+  if woCompact in Options then
+    Write('{}')
+  else
+    begin
+    Writeln('{');
+    Write('}');
+    end;
+end;
+
+procedure TJSWriter.WriteEmptyStatement(El: TJSEmptyStatement);
+begin
+  if El=nil then ;
+  if woEmptyStatementAsComment in Options then
+    Write('/* Empty statement */')
+end;
+
+procedure TJSWriter.WriteRegularExpressionLiteral(
+  El: TJSRegularExpressionLiteral);
+
+begin
+  Write('/');
+  Write(EscapeString(El.Pattern.AsString,jseqBoth));
+  Write('/');
+  If Assigned(El.PatternFlags) then
+    Write(EscapeString(El.PatternFlags.AsString,jseqBoth));
+end;
+
+procedure TJSWriter.WriteLiteral(El: TJSLiteral);
+begin
+  WriteValue(El.Value);
+end;
+
+procedure TJSWriter.WritePrimaryExpression(El: TJSPrimaryExpression);
+
+begin
+  if El is TJSPrimaryExpressionThis then
+    Write('this')
+  else if El is TJSPrimaryExpressionIdent then
+    Write(TJSPrimaryExpressionIdent(El).Name)
+  else
+    Error(SErrUnknownJSClass,[El.ClassName]);
+end;
+
+procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
+
+type
+  BracketString = string{$ifdef fpc}[2]{$endif};
+Var
+  Chars : Array[Boolean] of BracketString = ('[]','()');
+
+Var
+  i,C : Integer;
+  isArgs,WC , MultiLine: Boolean;
+  BC : BracketString;
+
+begin
+  isArgs:=El is TJSArguments;
+  BC:=Chars[isArgs];
+  C:=El.Elements.Count-1;
+  if C=-1 then
+    begin
+    Write(BC);
+    Exit;
+    end;
+  WC:=(woCompact in Options) or
+      ((Not isArgs) and (woCompactArrayLiterals in Options)) or
+      (isArgs and (woCompactArguments in Options)) ;
+  MultiLine:=(not WC) and (C>4);
+  if MultiLine then
+    begin
+    Writeln(BC[1]);
+    Indent;
+    end
+  else
+    Write(BC[1]);
+  For I:=0 to C do
+    begin
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Elements[i].Expr);
+    if I<C then
+      if WC then
+        Write(',')
+      else if MultiLine then
+        Writeln(',')
+      else
+        Write(', ');
+    end;
+  if MultiLine then
+    begin
+    Writeln('');
+    Undent;
+    end;
+  Writer.CurElement:=El;
+  Write(BC[2]);
+end;
+
+
+procedure TJSWriter.WriteObjectLiteral(El: TJSObjectLiteral);
+Var
+  i,C : Integer;
+  QE,WC : Boolean;
+  S : TJSString;
+  Prop: TJSObjectLiteralElement;
+begin
+  C:=El.Elements.Count-1;
+  QE:=(woQuoteElementNames in Options);
+  if C=-1 then
+    begin
+    Write('{}');
+    Exit;
+    end;
+  WC:=(woCompact in Options) or (woCompactObjectLiterals in Options);
+  if WC then
+    Write('{')
+  else
+    begin
+    Writeln('{');
+    Indent;
+    end;
+  For I:=0 to C do
+   begin
+   Prop:=El.Elements[i];
+   Writer.CurElement:=Prop.Expr;
+   S:=Prop.Name;
+   if QE or not IsValidJSIdentifier(S) then
+     begin
+     if (length(S)>1)
+         and (((S[1]='"') and (S[length(S)]='"'))
+           or ((S[1]='''') and (S[length(S)]=''''))) then
+       // already quoted
+     else
+       S:=QuoteJSString(s);
+     end;
+   Write(S+': ');
+   Indent;
+   FSkipRoundBrackets:=true;
+   WriteJS(Prop.Expr);
+   if I<C then
+     if WC then Write(', ') else Writeln(',');
+   Undent;
+   end;
+  FSkipRoundBrackets:=false;
+  if not WC then
+    begin
+    Writeln('');
+    Undent;
+    end;
+  Writer.CurElement:=El;
+  Write('}');
+end;
+
+procedure TJSWriter.WriteMemberExpression(El: TJSMemberExpression);
+
+var
+  MExpr: TJSElement;
+  Args: TJSArguments;
+begin
+  if El is TJSNewMemberExpression then
+    Write('new ');
+  MExpr:=El.MExpr;
+  if (MExpr is TJSPrimaryExpression)
+      or (MExpr is TJSDotMemberExpression)
+      or (MExpr is TJSBracketMemberExpression)
+      // Note: new requires brackets in this case: new (a())()
+      or ((MExpr is TJSCallExpression) and not (El is TJSNewMemberExpression))
+      or (MExpr is TJSLiteral) then
+    begin
+    WriteJS(MExpr);
+    Writer.CurElement:=El;
+    end
+  else
+    begin
+    Write('(');
+    WriteJS(MExpr);
+    Writer.CurElement:=El;
+    Write(')');
+    end;
+  if El is TJSDotMemberExpression then
+    begin
+    Write('.');
+    Write(TJSDotMemberExpression(El).Name);
+    end
+  else if El is TJSBracketMemberExpression then
+    begin
+    write('[');
+    FSkipRoundBrackets:=true;
+    WriteJS(TJSBracketMemberExpression(El).Name);
+    Writer.CurElement:=El;
+    FSkipRoundBrackets:=false;
+    write(']');
+    end
+  else if (El is TJSNewMemberExpression) then
+    begin
+    Args:=TJSNewMemberExpression(El).Args;
+    if Assigned(Args) then
+      begin
+      Writer.CurElement:=Args;
+      WriteArrayLiteral(Args);
+      end
+    else
+      Write('()');
+    end;
+end;
+
+procedure TJSWriter.WriteCallExpression(El: TJSCallExpression);
+
+begin
+  WriteJS(El.Expr);
+  if Assigned(El.Args) then
+    begin
+    Writer.CurElement:=El.Args;
+    WriteArrayLiteral(El.Args);
+    end
+  else
+    begin
+    Writer.CurElement:=El;
+    Write('()');
+    end;
+end;
+
+procedure TJSWriter.WriteUnary(El: TJSUnary);
+Var
+  S : String;
+begin
+  FSkipRoundBrackets:=false;
+  S:=El.PreFixOperator;
+  if (S<>'') then
+    begin
+    case S[1] of
+    '+': if FLastChar='+' then Write(' ');
+    '-': if FLastChar='-' then Write(' ');
+    end;
+    Write(S);
+    end;
+  WriteJS(El.A);
+  if (S='') then
+    begin
+    S:=El.PostFixOperator;
+    if (S<>'') then
+      begin
+      Writer.CurElement:=El;
+      if ((S='-') and (FLastChar='-'))
+          or ((S='+') and (FLastChar='+')) then
+        Write(' ');
+      Write(S);
+      end;
+    end;
+end;
+
+procedure TJSWriter.WriteStatementList(El: TJSStatementList);
+
+Var
+  C : Boolean;
+  B : Boolean;
+  LastEl: TJSElement;
+
+begin
+  //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipCurlyBrackets,true));
+  //if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
+  //if El.B<>nil then write(' El.B='+El.B.ClassName) else write(' El.B=nil');
+  //writeln(' ');
+
+  C:=(woCompact in Options);
+  B:= Not FSkipCurlyBrackets;
+  if B then
+    begin
+    Write('{');
+    Indent;
+    if not C then writeln('');
+    end;
+  if not IsEmptyStatement(El.A) then
+    begin
+    WriteJS(El.A);
+    LastEl:=El.A;
+    if Assigned(El.B) then
+      begin
+      if not (LastEl is TJSStatementList) then
+        begin
+        if C then
+          Write('; ')
+        else
+          Writeln(';');
+        end;
+      FSkipCurlyBrackets:=True;
+      WriteJS(El.B);
+      LastEl:=El.B;
+      end;
+    if (not C) and not (LastEl is TJSStatementList) then
+      writeln(';');
+    end
+  else if Assigned(El.B) then
+    begin
+    WriteJS(El.B);
+    if (not C) and not (El.B is TJSStatementList) then
+      writeln(';');
+    end;
+  if B then
+    begin
+    Undent;
+    Writer.CurElement:=El;
+    Write('}'); // do not writeln
+    end;
+end;
+
+procedure TJSWriter.WriteWithStatement(El: TJSWithStatement);
+begin
+   Write('with (');
+   FSkipRoundBrackets:=true;
+   WriteJS(El.A);
+   FSkipRoundBrackets:=false;
+   Writer.CurElement:=El;
+   if (woCompact in Options) then
+     Write(') ')
+   else
+     WriteLn(')');
+   Indent;
+   WriteJS(El.B);
+   Undent;
+end;
+
+procedure TJSWriter.WriteVarDeclarationList(El: TJSVariableDeclarationList);
+
+begin
+  WriteJS(El.A);
+  If Assigned(El.B) then
+    begin
+    Write(', ');
+    WriteJS(El.B);
+    end;
+end;
+
+procedure TJSWriter.WriteBinary(El: TJSBinary);
+
+Var
+  S : String;
+  AllowCompact, WithBrackets: Boolean;
+  ElC: TClass;
+begin
+  {$IFDEF VerboseJSWriter}
+  System.writeln('TJSWriter.WriteBinary SkipRoundBrackets=',FSkipRoundBrackets);
+  {$ENDIF}
+  WithBrackets:=not FSkipRoundBrackets;
+  if WithBrackets then
+    Write('(');
+  FSkipRoundBrackets:=false;
+  ElC:=El.ClassType;
+  if El.A is TJSBinaryExpression then
+    if (El.A.ClassType=ElC)
+        and ((ElC=TJSLogicalOrExpression)
+        or (ElC=TJSLogicalAndExpression)
+        or (ElC=TJSBitwiseAndExpression)
+        or (ElC=TJSBitwiseOrExpression)
+        or (ElC=TJSBitwiseXOrExpression)
+        or (ElC=TJSAdditiveExpressionPlus)
+        or (ElC=TJSAdditiveExpressionMinus)
+        or (ElC=TJSMultiplicativeExpressionMul)) then
+      FSkipRoundBrackets:=true;
+  WriteJS(El.A);
+  Writer.CurElement:=El;
+  AllowCompact:=False;
+  if (El is TJSBinaryExpression) then
+    begin
+    S:=TJSBinaryExpression(El).OperatorString;
+    AllowCompact:=TJSBinaryExpression(El).AllowCompact;
+    end;
+  If Not (AllowCompact and (woCompact in Options)) then
+    begin
+    if El is TJSCommaExpression then
+      S:=S+' '
+    else
+      S:=' '+S+' ';
+    end;
+  FSkipRoundBrackets:=false;
+  ElC:=El.ClassType;
+  if El.B is TJSBinaryExpression then
+    if (El.B.ClassType=ElC)
+        and ((ElC=TJSLogicalOrExpression)
+        or (ElC=TJSLogicalAndExpression)) then
+      FSkipRoundBrackets:=true;
+  // Note: a+(b+c) <> a+b+c  e.g. floats, 0+string
+  Write(S);
+  WriteJS(El.B);
+  Writer.CurElement:=El;
+  if WithBrackets then
+    Write(')');
+end;
+
+function TJSWriter.IsEmptyStatement(El: TJSElement): boolean;
+begin
+  if (El=nil) then
+    exit(true);
+  if (El.ClassType=TJSEmptyStatement) and not (woEmptyStatementAsComment in Options) then
+    exit(true);
+  Result:=false;
+end;
+
+function TJSWriter.HasLineEnding(El: TJSElement): boolean;
+begin
+  if El<>nil then
+    begin
+    if (El.ClassType=TJSStatementList) or (El.ClassType=TJSSourceElements) then
+      exit(true);
+    end;
+  Result:=false;
+end;
+
+procedure TJSWriter.WriteConditionalExpression(El: TJSConditionalExpression);
+
+var
+  NeedBrackets: Boolean;
+begin
+  NeedBrackets:=true;
+  if NeedBrackets then
+    begin
+    write('(');
+    FSkipRoundBrackets:=true;
+    end;
+  WriteJS(El.A);
+  write(' ? ');
+  if El.B<>nil then
+    WriteJS(El.B);
+  write(' : ');
+  if El.C<>nil then
+    WriteJS(El.C);
+  if NeedBrackets then
+    write(')');
+end;
+
+procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement);
+
+Var
+  S : String;
+begin
+  WriteJS(El.LHS);
+  Writer.CurElement:=El;
+  S:=El.OperatorString;
+  If Not (woCompact in Options) then
+    S:=' '+S+' ';
+  Write(S);
+  FSkipRoundBrackets:=true;
+  WriteJS(El.Expr);
+  FSkipRoundBrackets:=false;
+end;
+
+procedure TJSWriter.WriteVarDeclaration(El: TJSVarDeclaration);
+
+begin
+  Write(El.Name);
+  if Assigned(El.Init) then
+    begin
+    Write(' = ');
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Init);
+    FSkipRoundBrackets:=false;
+    end;
+end;
+
+procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
+
+var
+  HasBTrue, C, HasBFalse, BTrueNeedBrackets: Boolean;
+begin
+  C:=woCompact in Options;
+  Write('if (');
+  FSkipRoundBrackets:=true;
+  WriteJS(El.Cond);
+  Writer.CurElement:=El;
+  FSkipRoundBrackets:=false;
+  Write(')');
+  If Not C then
+    Write(' ');
+  HasBTrue:=not IsEmptyStatement(El.BTrue);
+  HasBFalse:=not IsEmptyStatement(El.BFalse);
+  if HasBTrue then
+    begin
+    // Note: the 'else' needs {} in front
+    BTrueNeedBrackets:=HasBFalse and not (El.BTrue is TJSStatementList)
+      and not (El.BTrue is TJSEmptyBlockStatement);
+    if BTrueNeedBrackets then
+      if C then
+        Write('{')
+      else
+        begin
+        Writeln('{');
+        Indent;
+        end;
+    WriteJS(El.BTrue);
+    if BTrueNeedBrackets then
+      if C then
+        Write('}')
+      else
+        begin
+        Undent;
+        Writeln('}');
+        end;
+    end;
+  if HasBFalse then
+    begin
+    Writer.CurElement:=El.BFalse;
+    if not HasBTrue then
+      begin
+      if C then
+        Write('{}')
+      else
+        Writeln('{}');
+      end
+    else
+      Write(' ');
+    Write('else ');
+    WriteJS(El.BFalse)
+    end
+  else
+    Writer.CurElement:=El;
+end;
+
+procedure TJSWriter.WriteForInStatement(El: TJSForInStatement);
+
+begin
+  Write('for (');
+  if Assigned(El.LHS) then
+    begin
+    WriteJS(El.LHS);
+    Writer.CurElement:=El;
+    end;
+  Write(' in ');
+  if Assigned(El.List) then
+    begin
+    WriteJS(El.List);
+    Writer.CurElement:=El;
+    end;
+  Write(') ');
+  if Assigned(El.Body) then
+    WriteJS(El.Body);
+end;
+
+procedure TJSWriter.WriteForStatement(El: TJSForStatement);
+
+begin
+  Write('for (');
+  if Assigned(El.Init) then
+    WriteJS(El.Init);
+  Write('; ');
+  if Assigned(El.Cond) then
+    begin
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Cond);
+    FSkipRoundBrackets:=false;
+    end;
+  Write('; ');
+  if Assigned(El.Incr) then
+    WriteJS(El.Incr);
+  Writer.CurElement:=El;
+  Write(') ');
+  if Assigned(El.Body) then
+    WriteJS(El.Body);
+end;
+
+procedure TJSWriter.WriteWhileStatement(El: TJSWhileStatement);
+
+
+begin
+  if El is TJSDoWhileStatement then
+    begin
+    Write('do ');
+    if Assigned(El.Body) then
+      begin
+      FSkipCurlyBrackets:=false;
+      WriteJS(El.Body);
+      Writer.CurElement:=El;
+      end;
+    Write(' while (');
+    If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
+      WriteJS(EL.Cond);
+      Writer.CurElement:=El;
+      FSkipRoundBrackets:=false;
+      end;
+    Write(')');
+    end
+  else
+    begin
+    Write('while (');
+    If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
+      WriteJS(EL.Cond);
+      Writer.CurElement:=El;
+      FSkipRoundBrackets:=false;
+      end;
+    Write(') ');
+    if Assigned(El.Body) then
+      WriteJS(El.Body);
+    end;
+end;
+
+procedure TJSWriter.WriteSwitchStatement(El: TJSSwitchStatement);
+
+Var
+  C : Boolean;
+  I : Integer;
+  EC : TJSCaseElement;
+
+begin
+  C:=(woCompact in Options);
+  Write('switch (');
+  If Assigned(El.Cond) then
+    begin
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Cond);
+    Writer.CurElement:=El;
+    FSkipRoundBrackets:=false;
+    end;
+  if C then
+    Write(') {')
+  else
+    Writeln(') {');
+  For I:=0 to El.Cases.Count-1 do
+    begin
+    EC:=El.Cases[i];
+    if EC=El.TheDefault then
+      Write('default')
+    else
+      begin
+      Writer.CurElement:=EC.Expr;
+      Write('case ');
+      FSkipRoundBrackets:=true;
+      WriteJS(EC.Expr);
+      FSkipRoundBrackets:=false;
+      end;
+    if Assigned(EC.Body) then
+      begin
+      FSkipCurlyBrackets:=true;
+      If C then
+        Write(': ')
+      else
+        Writeln(':');
+      Indent;
+      WriteJS(EC.Body);
+      Undent;
+      if (EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement) then
+        begin
+        if C then
+          begin
+          if I<El.Cases.Count-1 then
+            Write(' ');
+          end
+        else
+          Writeln('');
+        end
+      else if C then
+        Write('; ')
+      else
+        Writeln(';');
+      end
+    else
+      begin
+      if C then
+        Write(': ')
+      else
+        Writeln(':');
+      end;
+    end;
+  Writer.CurElement:=El;
+  Write('}');
+end;
+
+procedure TJSWriter.WriteTargetStatement(El: TJSTargetStatement);
+
+Var
+  TN : TJSString;
+
+begin
+  TN:=El.TargetName;
+  if (El is TJSForStatement) then
+    WriteForStatement(TJSForStatement(El))
+  else if (El is TJSSwitchStatement) then
+    WriteSwitchStatement(TJSSwitchStatement(El))
+  else if (El is TJSForInStatement) then
+    WriteForInStatement(TJSForInStatement(El))
+  else if El is TJSWhileStatement then
+    WriteWhileStatement(TJSWhileStatement(El))
+  else if (El is TJSContinueStatement) then
+    begin
+    if (TN<>'') then
+      Write('continue '+TN)
+    else
+      Write('continue');
+    end
+  else if (El is TJSBreakStatement) then
+    begin
+   if (TN<>'') then
+      Write('break '+TN)
+    else
+      Write('break');
+    end
+  else
+    Error('Unknown target statement class: "%s"',[El.ClassName])
+end;
+
+procedure TJSWriter.WriteReturnStatement(El: TJSReturnStatement);
+
+begin
+  if El.Expr=nil then
+    Write('return')
+  else
+    begin
+    Write('return ');
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Expr);
+    FSkipRoundBrackets:=false;
+    end;
+end;
+
+procedure TJSWriter.WriteLabeledStatement(El: TJSLabeledStatement);
+begin
+  if Assigned(El.TheLabel) then
+    begin
+    Write(El.TheLabel.Name);
+    if woCompact in Options then
+      Write(': ')
+    else
+      Writeln(':');
+    end;
+  // Target ??
+  WriteJS(El.A);
+end;
+
+procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
+
+Var
+  C : Boolean;
+
+begin
+  C:=woCompact in Options;
+  Write('try {');
+  if not IsEmptyStatement(El.Block) then
+    begin
+    if Not C then writeln('');
+    FSkipCurlyBrackets:=True;
+    Indent;
+    WriteJS(El.Block);
+    if (Not C) and (not (El.Block is TJSStatementList)) then writeln('');
+    Undent;
+    end;
+  Writer.CurElement:=El;
+  Write('}');
+  If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
+    begin
+    Write(' catch');
+    if El.Ident<>'' then Write(' ('+El.Ident+')');
+    If C then
+      Write(' {')
+    else
+      Writeln(' {');
+    if not IsEmptyStatement(El.BCatch) then
+      begin
+      FSkipCurlyBrackets:=True;
+      Indent;
+      WriteJS(El.BCatch);
+      Undent;
+      if (Not C) and (not (El.BCatch is TJSStatementList)) then writeln('');
+      end;
+    Writer.CurElement:=El;
+    Write('}');
+    end;
+  If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then
+    begin
+    If C then
+      Write(' finally {')
+    else
+      Writeln(' finally {');
+    if not IsEmptyStatement(El.BFinally) then
+      begin
+      Indent;
+      FSkipCurlyBrackets:=True;
+      WriteJS(El.BFinally);
+      Undent;
+      if (Not C) and (not (El.BFinally is TJSStatementList)) then writeln('');
+      end;
+    Writer.CurElement:=El;
+    Write('}');
+    end;
+end;
+
+procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody);
+
+begin
+  //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipCurlyBrackets,'true','false'));
+  if not IsEmptyStatement(El.A) then
+    WriteJS(El.A);
+end;
+
+procedure TJSWriter.WriteFunctionDeclarationStatement(
+  El: TJSFunctionDeclarationStatement);
+
+begin
+  if Assigned(El.AFunction) then
+    WriteFuncDef(El.AFunction);
+end;
+
+procedure TJSWriter.WriteSourceElements(El: TJSSourceElements);
+
+Var
+  C : Boolean;
+
+  Procedure WriteElements(Elements: TJSElementNodes);
+  Var
+    I : Integer;
+    E : TJSElement;
+  begin
+    if Elements=nil then exit;
+    For I:=0 to Elements.Count-1 do
+      begin
+      E:=Elements.Nodes[i].Node;
+      WriteJS(E);
+      if Not C then
+        WriteLn(';')
+      else
+        if I<Elements.Count-1 then
+          Write('; ')
+        else
+          Write(';')
+      end;
+  end;
+
+begin
+  C:=(woCompact in Options);
+  WriteElements(El.Vars);
+  WriteElements(El.Functions);
+  WriteElements(El.Statements);
+end;
+
+procedure TJSWriter.WriteVariableStatement(El: TJSVariableStatement);
+
+begin
+  Write('var ');
+  FSkipRoundBrackets:=true;
+  WriteJS(El.A);
+end;
+
+procedure TJSWriter.WriteJS(El: TJSElement);
+var
+  C: TClass;
+begin
+{$IFDEF DEBUGJSWRITER}
+  if (El<>Nil) then
+    system.Writeln('WriteJS : ',El.ClassName,' ',El.Line,',',El.Column)
+  else
+    system.Writeln('WriteJS : El = Nil');
+{$ENDIF}
+  Writer.CurElement:=El;
+  C:=El.ClassType;
+  if (C=TJSEmptyBlockStatement ) then
+    WriteEmptyBlockStatement(TJSEmptyBlockStatement(El))
+  else if (C=TJSEmptyStatement) then
+    WriteEmptyStatement(TJSEmptyStatement(El))
+  else if (C=TJSLiteral) then
+    WriteLiteral(TJSLiteral(El))
+  else if C.InheritsFrom(TJSPrimaryExpression) then
+    WritePrimaryExpression(TJSPrimaryExpression(El))
+  else if C.InheritsFrom(TJSArrayLiteral) then
+    WriteArrayLiteral(TJSArrayLiteral(El))
+  else if (C=TJSObjectLiteral) then
+    WriteObjectLiteral(TJSObjectLiteral(El))
+  else if C.InheritsFrom(TJSMemberExpression) then
+    WriteMemberExpression(TJSMemberExpression(El))
+  else if (C=TJSRegularExpressionLiteral) then
+    WriteRegularExpressionLiteral(TJSRegularExpressionLiteral(El))
+  else if (C=TJSCallExpression) then
+    WriteCallExpression(TJSCallExpression(El))
+  else if (C=TJSLabeledStatement) then // Before unary
+    WriteLabeledStatement(TJSLabeledStatement(El))
+  else if (C=TJSFunctionBody) then // Before unary
+    WriteFunctionBody(TJSFunctionBody(El))
+  else if (C=TJSVariableStatement) then // Before unary
+    WriteVariableStatement(TJSVariableStatement(El))
+  else if C.InheritsFrom(TJSUnary) then
+    WriteUnary(TJSUnary(El))
+  else if (C=TJSVariableDeclarationList) then
+    WriteVarDeclarationList(TJSVariableDeclarationList(El)) // Must be before binary
+  else if (C=TJSStatementList) then
+    WriteStatementList(TJSStatementList(El)) // Must be before binary
+  else if (C=TJSWithStatement) then
+    WriteWithStatement(TJSWithStatement(El)) // Must be before binary
+  else if C.InheritsFrom(TJSBinary) then
+    WriteBinary(TJSBinary(El))
+  else if (C=TJSConditionalExpression) then
+    WriteConditionalExpression(TJSConditionalExpression(El))
+  else if C.InheritsFrom(TJSAssignStatement) then
+    WriteAssignStatement(TJSAssignStatement(El))
+  else if (C=TJSVarDeclaration) then
+    WriteVarDeclaration(TJSVarDeclaration(El))
+  else if (C=TJSIfStatement) then
+    WriteIfStatement(TJSIfStatement(El))
+  else if C.InheritsFrom(TJSTargetStatement) then
+    WriteTargetStatement(TJSTargetStatement(El))
+  else if (C=TJSReturnStatement) then
+    WriteReturnStatement(TJSReturnStatement(El))
+  else if C.InheritsFrom(TJSTryStatement) then
+    WriteTryStatement(TJSTryStatement(El))
+  else if (C=TJSFunctionDeclarationStatement) then
+    WriteFunctionDeclarationStatement(TJSFunctionDeclarationStatement(El))
+  else if (C=TJSSourceElements) then
+    WriteSourceElements(TJSSourceElements(El))
+  else if El=Nil then
+    Error(SErrNilNode)
+  else
+    Error(SErrUnknownJSClass,[El.ClassName]);
+//  Write('/* '+El.ClassName+' */');
+  FSkipCurlyBrackets:=False;
+end;
+
+{$ifdef HasFileWriter}
+{ TFileWriter }
+
+Function TFileWriter.DoWrite(Const S: TJSWriterString) : Integer;
+begin
+  Result:=Length(S);
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.DoWrite ToDo ',S);
+  {$else}
+  system.Write(FFile,S);
+  {$endif}
+end;
+
+{$ifdef FPC_HAS_CPSTRING}
+Function TFileWriter.DoWrite(Const S: UnicodeString) : Integer;
+begin
+  Result:=Length(S)*SizeOf(UnicodeChar);
+  system.Write(FFile,S);
+end;
+{$endif}
+
+Constructor TFileWriter.Create(Const AFileName: String);
+begin
+  inherited Create;
+  FFileName:=AFileName;
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.Create ToDo ',AFileName);
+  {$else}
+  Assign(FFile,AFileName);
+  Rewrite(FFile);
+  {$endif}
+end;
+
+Destructor TFileWriter.Destroy;
+begin
+  Close;
+  Inherited;
+end;
+
+Procedure TFileWriter.Flush;
+begin
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.Flush ToDO');
+  {$else}
+  system.Flush(FFile);
+  {$endif}
+end;
+
+Procedure TFileWriter.Close;
+begin
+  {$ifdef NodeJS}
+  system.writeln('TFileWriter.DoWrite ToDo ');
+  {$else}
+  system.Close(FFile);
+  {$endif}
+end;
+{$endif}
+
+{ TTextWriter }
+
+procedure TTextWriter.SetCurElement(const AValue: TJSElement);
+begin
+  FCurElement:=AValue;
+end;
+
+procedure TTextWriter.Writing;
+begin
+  if Assigned(OnWriting) then
+    OnWriting(Self);
+end;
+
+constructor TTextWriter.Create;
+begin
+  FCurLine:=1;
+  FCurColumn:=1;
+end;
+
+{$ifdef FPC_HAS_CPSTRING}
+function TTextWriter.Write(const S: UnicodeString): Integer;
+var
+  p: PWideChar;
+  c: WideChar;
+begin
+  if S='' then exit;
+  Writing;
+  Result:=DoWrite(S);
+  p:=PWideChar(S);
+  repeat
+    c:=p^;
+    case c of
+    #0:
+      if p-PWideChar(S)=length(S)*2 then
+        break
+      else
+        inc(FCurColumn);
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
+      continue;
+      end;
+    else
+      // ignore low/high surrogate, CurColumn is char index, not codepoint
+      inc(FCurColumn);
+    end;
+    inc(p);
+  until false;
+end;
+{$endif}
+
+function TTextWriter.Write(const S: TJSWriterString): Integer;
+var
+  c: Char;
+  l, p: Integer;
+begin
+  if S='' then exit;
+  Writing;
+  Result:=DoWrite(S);
+  l:=length(S);
+  p:=1;
+  while p<=l do
+    begin
+    c:=S[p];
+    case c of
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p<=l) and (S[p] in [#10,#13]) and (c<>S[p]) then inc(p);
+      end;
+    else
+      // Note about UTF-8 multibyte chars: CurColumn is char index, not codepoint
+      inc(FCurColumn);
+      inc(p);
+    end;
+    end;
+end;
+
+function TTextWriter.WriteLn(const S: TJSWriterString): Integer;
+begin
+  Result:=Write(S)+Write(sLineBreak);
+end;
+
+function TTextWriter.Write(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
+
+begin
+  Result:=Write(Format(Fmt,Args));
+end;
+
+function TTextWriter.WriteLn(const Fmt: TJSWriterString;
+  Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
+begin
+  Result:=WriteLn(Format(Fmt,Args));
+end;
+
+function TTextWriter.Write(const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
+
+Var
+  I : Integer;
+  {$ifdef pas2js}
+  V: jsvalue;
+  S: TJSWriterString;
+  {$else}
+  V : TVarRec;
+  S : String;
+  U : UnicodeString;
+  {$endif}
+
+begin
+  Result:=0;
+  For I:=Low(Args) to High(Args) do
+    begin
+    V:=Args[i];
+    S:='';
+    {$ifdef pas2js}
+    case jsTypeOf(V) of
+    'boolean':
+      if V then S:='true' else S:='false';
+    'number':
+      if isInteger(V) then
+        S:=str(NativeInt(V))
+      else
+        S:=str(Double(V));
+    'string':
+      S:=String(V);
+    else continue;
+    end;
+    Result:=Result+Write(S);
+    {$else}
+    U:='';
+    case V.VType of
+       vtInteger       : Str(V.VInteger,S);
+       vtBoolean       : if V.VBoolean then s:='true' else s:='false';
+       vtChar          : s:=V.VChar;
+       vtWideChar      : U:=V.VWideChar;
+       vtExtended      : Str(V.VExtended^,S);
+       vtString        : S:=V.VString^;
+       vtPChar         : S:=V.VPChar;
+       vtPWideChar     : U:=V.VPWideChar;
+       vtAnsiString    : S:=PChar(V.VAnsiString);
+       vtCurrency      : Str(V.VCurrency^,S);
+       vtVariant       : S:=V.VVariant^;
+       vtWideString    : U:=PWideChar(V.VWideString);
+       vtInt64         : Str(V.VInt64^,S);
+       vtUnicodeString : U:=PWideChar(V.VUnicodeString);
+       vtQWord         : Str(V.VQWord^,S);
+    end;
+    if (U<>'') then
+      Result:=Result+Write(u)
+    else if (S<>'') then
+      Result:=Result+Write(s);
+    {$endif}
+    end;
+end;
+
+function TTextWriter.WriteLn(
+  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): Integer;
+begin
+  Result:=Write(Args)+Writeln('');
+end;
+
+end.
+

+ 2576 - 0
compiler/packages/fcl-js/tests/tcparser.pp

@@ -0,0 +1,2576 @@
+unit tcparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, jsParser, jstree, jsbase;
+
+type
+
+  { TTestJSParser }
+
+  TTestJSParser= class(TTestCase)
+  Private
+    FSource : TStringStream;
+    FParser : TJSParser;
+    FSE : TJSSourceElements;
+    FToFree: TJSElement;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override;
+    Procedure CreateParser(Const ASource : string);
+    Procedure CheckClass(E : TJSElement; C : TJSElementClass);
+    Procedure AssertEquals(Const AMessage : String; Expected, Actual : TJSType); overload;
+    Procedure AssertIdentifier(Msg : String; El : TJSElement; Const AName : TJSString);
+    Function  GetSourceElements : TJSSourceElements;
+    Function  GetVars : TJSElementNodes;
+    Function  GetStatements : TJSElementNodes;
+    Function  GetFunctions : TJSElementNodes;
+    Function  GetFirstStatement : TJSElement;
+    Function  GetFirstVar : TJSElement;
+    Function  GetExpressionStatement : TJSExpressionStatement;
+  published
+    procedure TestEmpty;
+    procedure TestSimple;
+    procedure TestSimpleExpressionNumericalLiteral;
+    procedure TestSimpleExpressionStringLiteral;
+    procedure TestSimpleExpressionBooleanLiteralFalse;
+    procedure TestSimpleExpressionBooleanLiteralTrue;
+    procedure TestSimpleExpressionIdentifier;
+    procedure TestSimpleExpressionNull;
+    procedure TestAssignExpressionNumerical;
+    procedure TestAssignExpressionNull;
+    procedure TestAssignExpressionString;
+    procedure TestAssignExpressionBooleanFalse;
+    procedure TestAssignExpressionBooleanTrue;
+    procedure TestAssignExpressionIdent;
+    procedure TestAssignExpressionPlus;
+    procedure TestAssignExpressionMinus;
+    procedure TestAssignExpressionDiv;
+    procedure TestAssignExpressionMul;
+    procedure TestAssignExpressionMod;
+    procedure TestAssignExpressionAnd;
+    procedure TestAssignExpressionOr;
+    procedure TestAssignExpressionXOr;
+    procedure TestAssignExpressionLShift;
+    procedure TestAssignExpressionRShift;
+    procedure TestAssignExpressionURShift;
+    procedure TestExpressionPlus;
+    procedure TestExpressionSub;
+    procedure TestExpressionMul;
+    procedure TestExpressionDiv;
+    procedure TestExpressionMod;
+    procedure TestExpressionLShift;
+    procedure TestExpressionRShift;
+    procedure TestExpressionURShift;
+    procedure TestExpressionPostPlusPlus;
+    procedure TestExpressionPostMinusMinus;
+    procedure TestExpressionPreMinusMinus;
+    procedure TestExpressionPrePlusPlus;
+    procedure TestExpressionPrecedenceMulPlus;
+    procedure TestExpressionPrecedencePlusMul;
+    procedure TestExpressionPrecedenceMulMinus;
+    procedure TestExpressionPrecedenceMinusMul;
+    procedure TestExpressionPrecedenceDivPlus;
+    procedure TestExpressionPrecedencePlusDiv;
+    procedure TestExpressionPrecedenceModPlus;
+    procedure TestExpressionPrecedencePlusMod;
+    procedure TestExpressionPrecedencePlusPostPlusPlus;
+    procedure TestExpressionPrecedencePlusPostMinusMinus;
+    procedure TestExpressionPrecedenceMulPostMinusMinus;
+    procedure TestExpressionPrecedenceMulPostPlusPlus;
+    procedure TestExpressionPrecedenceMulPreMinusMinus;
+    procedure TestExpressionPrecedenceMulPrePlusPlus;
+    procedure TestExpressionPrecedencePlusPreMinusMinus;
+    procedure TestExpressionPrecedencePlusPrePlusPlus;
+    procedure TestExpressionPrecedencePlusInv;
+    procedure TestExpressionPrecedenceMulInv;
+    procedure TestExpressionPrecedenceMulNot;
+    procedure TestExpressionPrecedencePlusNot;
+    procedure TestExpressionPrecedenceBraceMulPlus;
+    procedure TestExpressionPrecedenceBracePlusMul;
+    procedure TestExpressionFunction;
+    procedure TestFunctionCallNoArgs;
+    procedure TestFunctionCallOneArg;
+    procedure TestFunctionCallTwoArgs;
+    procedure TestArrayExpressionNumericalArgs;
+    procedure TestArrayExpressionStringArgs;
+    procedure TestArrayExpressionIdentArgs;
+    Procedure TestVarDeclarationSimple;
+    procedure TestVarDeclarationDouble;
+    procedure TestVarDeclarationSimpleInit;
+    procedure TestVarDeclarationDoubleInit;
+    procedure TestBlockEmpty;
+    procedure TestBlockEmptyStatement;
+    procedure TestBlockSimpleStatement;
+    procedure TestFunctionDeclarationEmpty;
+    procedure TestFunctionDeclarationWithArgs;
+    procedure TestFunctionDeclarationWithBody;
+    procedure TestIfSimple;
+    procedure TestIfElseSimple;
+    procedure TestIfEmptyBlock;
+    procedure TestIfEmptyBlockElse;
+    procedure TestWhileSimple;
+    procedure TestWhileBlock;
+    procedure TestDoWhileSimple;
+    procedure TestDoWhileBlock;
+    procedure TestForEmpty;
+    procedure TestForEmptyBody;
+    procedure TestForSimpleBody;
+    procedure TestTryCatch;
+    procedure TestTryCatchFinally;
+    procedure TestTryFinally;
+    procedure TestThrow;
+    procedure TestReturn;
+    procedure TestAssignment;
+    procedure TestNew;
+    procedure TestLabeledStatement;
+    procedure TestContinue;
+    procedure TestContinueTarget;
+    procedure TestBreak;
+    procedure TestBreakTarget;
+    procedure TestSwitchEmpty;
+    procedure TestSwitchOne;
+    procedure TestSwitchTwo;
+    procedure TestSwitchTwoDefault;
+  end;
+
+implementation
+
+uses typinfo;
+
+Procedure TTestJSParser.AssertEquals(Const AMessage: String; Expected,
+  Actual: TJSType);
+
+Var
+  NE,NA : String;
+
+begin
+  NE:=GetEnumName(TypeInfo(TJSType),Ord(Expected));
+  NA:=GetEnumName(TypeInfo(TJSType),Ord(Actual));
+  AssertEquals(AMessage,NE,NA);
+end;
+
+Procedure TTestJSParser.AssertIdentifier(Msg: String; El: TJSElement;
+  Const AName: TJSString);
+
+Var
+  L : TJSPrimaryExpressionIdent;
+  S1,S2 : String;
+begin
+  AssertNotNull(Msg+' have TJSPrimaryExpressionIdent element',El);
+  CheckClass(El,TJSPrimaryExpressionIdent);
+  L:=TJSPrimaryExpressionIdent(el);
+  S1:=L.Name;
+  S2:=Aname;
+  AssertEquals(Msg+'Identifier has correct name',S2,S1);
+end;
+
+Function TTestJSParser.GetFirstStatement: TJSElement;
+
+Var
+  E : TJSElementNodes;
+begin
+  E:=GetStatements;
+  AssertNotNull('Have statements',E);
+  AssertEquals('1 statement',1,E.Count);
+  Result:=E.Nodes[0].Node;
+  AssertNotNull('First statement assigned',Result);
+end;
+
+Function TTestJSParser.GetFirstVar: TJSElement;
+Var
+  E : TJSElementNodes;
+begin
+  E:=GetVars;
+  AssertNotNull('Have statements',E);
+  Writeln('Count : ',E.Count);
+  If (E.Count=0) then
+    Fail('Zero variables defined');
+  Result:=E.Nodes[0].Node;
+  AssertNotNull('First variable declaration',Result);
+end;
+
+Function TTestJSParser.GetExpressionStatement: TJSExpressionStatement;
+
+Var
+  N : TJSElement;
+begin
+  N:=GetFirstStatement;
+  CheckClass(N,TJSExpressionStatement);
+  Result:=TJSExpressionStatement(N);
+end;
+
+
+procedure TTestJSParser.TestSimple;
+
+Var
+  E : TJSElementNodes;
+  N : TJSElement;
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('1;');
+  E:=GetStatements;
+  AssertNotNull('Have statements',E);
+  AssertEquals('1 statement',1,E.Count);
+  N:=E.Nodes[0].Node;
+  AssertNotNull('First statement assigned',N);
+  AssertNotNull('First statement assigned',N);
+  CheckClass(N,TJSExpressionStatement);
+  X:=TJSExpressionStatement(N);
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLiteral);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionNumericalLiteral;
+Var
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLiteral);
+  AssertNotNull('Expression value assigned',TJSLiteral(X.A).Value);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(X.A).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0,TJSLiteral(X.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionStringLiteral;
+
+Var
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('"string";');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLiteral);
+  AssertNotNull('Expression value assigned',TJSLiteral(X.A).Value);
+  AssertEquals('Expression value type correct', jstString,TJSLiteral(X.A).Value.ValueType);
+  AssertEquals('Expression value correct', 'string',TJSLiteral(X.A).Value.AsString);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionBooleanLiteralFalse;
+
+Var
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('false;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLiteral);
+  AssertNotNull('Expression value assigned',TJSLiteral(X.A).Value);
+  AssertEquals('Expression value type correct', jstBoolean,TJSLiteral(X.A).Value.ValueType);
+  AssertEquals('Expression value correct', False, TJSLiteral(X.A).Value.AsBoolean);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionIdentifier;
+
+Var
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('Something;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression value assigned','Something',TJSPrimaryExpressionIdent(X.A).Name);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionNull;
+
+Var
+  X : TJSExpressionStatement;
+begin
+    CreateParser('null;');
+    X:=GetExpressionStatement;
+    AssertNotNull('Expression statement assigned',X.A);
+    CheckClass(X.A,TJSLiteral);
+    AssertNotNull('Expression value assigned',TJSLiteral(X.A).Value);
+    AssertEquals('Expression value type correct', jstNull,TJSLiteral(X.A).Value.ValueType);
+    AssertEquals('Expression value correct', True, TJSLiteral(X.A).Value.IsNull);
+end;
+
+procedure TTestJSParser.TestAssignExpressionNumerical;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionString;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a="string";');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstString,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 'string', TJSLiteral(SA.Expr).Value.AsString);
+end;
+
+procedure TTestJSParser.TestAssignExpressionBooleanFalse;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a=false;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstBoolean,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', False, TJSLiteral(SA.Expr).Value.AsBoolean);
+end;
+
+procedure TTestJSParser.TestAssignExpressionBooleanTrue;
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a=true;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstBoolean,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', True, TJSLiteral(SA.Expr).Value.AsBoolean);
+end;
+
+procedure TTestJSParser.TestAssignExpressionNull;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a=null;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNull,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', True, TJSLiteral(SA.Expr).Value.IsNull);
+end;
+
+procedure TTestJSParser.TestAssignExpressionIdent;
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSimpleAssignStatement;
+begin
+  CreateParser('a=b;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  SA:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression value type correct', 'b',TJSPrimaryExpressionIdent(SA.Expr).Name);
+end;
+
+procedure TTestJSParser.TestAssignExpressionPlus;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSAddEqAssignStatement;
+
+begin
+  CreateParser('a+=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAddEqAssignStatement);
+  SA:=TJSAddEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionMinus;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSSubEqAssignStatement;
+
+begin
+  CreateParser('a-=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSSubEqAssignStatement);
+  SA:=TJSSubEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionMul;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSMulEqAssignStatement;
+
+begin
+  CreateParser('a*=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMulEqAssignStatement);
+  SA:=TJSMulEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionDiv;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSDivEqAssignStatement;
+
+begin
+  CreateParser('a/=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSDivEqAssignStatement);
+  SA:=TJSDivEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionMod;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSModEqAssignStatement;
+
+begin
+  CreateParser('a%=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSModEqAssignStatement);
+  SA:=TJSModEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionAnd;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSAndEqAssignStatement;
+
+begin
+  CreateParser('a&=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAndEqAssignStatement);
+  SA:=TJSAndEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionOr;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSOrEqAssignStatement;
+
+begin
+  CreateParser('a|=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSOrEqAssignStatement);
+  SA:=TJSOrEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionXOr;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSXOrEqAssignStatement;
+
+begin
+  CreateParser('a^=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSXOrEqAssignStatement);
+  SA:=TJSXOrEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionLShift;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSLShiftEqAssignStatement;
+
+begin
+  CreateParser('a<<=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLShiftEqAssignStatement);
+  SA:=TJSLShiftEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionRShift;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSRShiftEqAssignStatement;
+
+begin
+  CreateParser('a>>=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSRShiftEqAssignStatement);
+  SA:=TJSRShiftEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestAssignExpressionURShift;
+
+Var
+  X : TJSExpressionStatement;
+  SA : TJSURShiftEqAssignStatement;
+
+begin
+  CreateParser('a>>>=1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSURShiftEqAssignStatement);
+  SA:=TJSURShiftEqAssignStatement(X.A);
+  AssertNotNull('Assignment LHS assigned',SA.LHS);
+  CheckClass(SA.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Expression LHS name correct', 'a',TJSPrimaryExpressionIdent(SA.LHS).Name);
+  AssertNotNull('Assignment Expression assigned',SA.Expr);
+  CheckClass(SA.EXPR,TJSLiteral);
+  AssertEquals('Expression value type correct', jstNumber,TJSLiteral(SA.Expr).Value.ValueType);
+  AssertEquals('Expression value correct', 1.0, TJSLiteral(SA.Expr).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('1+2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionSub;
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionMinus;
+
+begin
+  CreateParser('1 - 2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionMinus);
+  E:=TJSAdditiveExpressionMinus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionMul;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('1*2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionDiv;
+Var
+  X : TJSExpressionStatement;
+  E : TJSMultiplicativeExpressionDiv;
+
+begin
+  CreateParser('1/2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionDiv);
+  E:=TJSMultiplicativeExpressionDiv(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionMod;
+Var
+  X : TJSExpressionStatement;
+  E : TJSMultiplicativeExpressionMod;
+
+begin
+  CreateParser('1%2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMod);
+  E:=TJSMultiplicativeExpressionMod(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionLShift;
+Var
+  X : TJSExpressionStatement;
+  E : TJSLShiftExpression;
+
+begin
+  CreateParser('1 << 2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLShiftExpression);
+  E:=TJSLShiftExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionRShift;
+Var
+  X : TJSExpressionStatement;
+  E : TJSRShiftExpression;
+
+begin
+  CreateParser('1 >> 2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSRShiftExpression);
+  E:=TJSRShiftExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionURShift;
+Var
+  X : TJSExpressionStatement;
+  E : TJSURShiftExpression;
+
+begin
+  CreateParser('1 >>> 2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSURShiftExpression);
+  E:=TJSURShiftExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSLiteral);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Expression left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression left operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertNotNull('Expression right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Expression left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 2.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPostPlusPlus;
+Var
+  X : TJSExpressionStatement;
+  E : TJSUnaryPostPlusPlusExpression;
+
+begin
+  CreateParser('1++;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSUnaryPostPlusPlusExpression);
+  E:=TJSUnaryPostPlusPlusExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Expression  operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPostMinusMinus;
+Var
+  X : TJSExpressionStatement;
+  E : TJSUnaryPostMinusMinusExpression;
+
+begin
+  CreateParser('1--;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSUnaryPostMinusMinusExpression);
+  E:=TJSUnaryPostMinusMinusExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Expression  operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrePlusPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSUnaryPrePlusPlusExpression;
+
+begin
+  CreateParser('++1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSUnaryPrePlusPlusExpression);
+  E:=TJSUnaryPrePlusPlusExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Expression  operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+end;
+
+
+procedure TTestJSParser.TestExpressionPreMinusMinus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSUnaryPreMinusMinusExpression;
+
+begin
+  CreateParser('--1;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSUnaryPreMinusMinusExpression);
+  E:=TJSUnaryPreMinusMinusExpression(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Expression  operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Expression operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression operand value correct', 1.0, TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionMul;
+begin
+  CreateParser('2 * 3 + 4;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSMultiplicativeExpressionMul);
+  R:=TJSMultiplicativeExpressionMul(E.A);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Multiplication right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 4.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceBraceMulPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSMultiplicativeExpressionMul;
+  R : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('2 * (3 + 4);');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSAdditiveExpressionPlus);
+  R:=TJSAdditiveExpressionPlus(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(E.A).Value.AsNumber);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(R.B).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Addition right operand value correct', 4.0,TJSLiteral(R.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceBracePlusMul;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSMultiplicativeExpressionMul;
+  R : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('(3 + 4)*2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSAdditiveExpressionPlus);
+  R:=TJSAdditiveExpressionPlus(E.A);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(E.B).Value.AsNumber);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(R.B).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Addition right operand value correct', 4.0,TJSLiteral(R.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionFunction;
+Var
+  X : TJSExpressionStatement;
+  A  : TJSSimpleAssignStatement;
+begin
+  CreateParser('a = function () {};');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSSimpleAssignStatement);
+  A:=TJSSimpleAssignStatement(X.A);
+  AssertNotNull('Have left operand',A.LHS);
+  CheckClass(A.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Correct name for assignment LHS ','a',TJSPrimaryExpressionIdent(A.LHS).Name);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusMul;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionMul;
+begin
+  CreateParser('4 + 2 * 3;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSMultiplicativeExpressionMul);
+  R:=TJSMultiplicativeExpressionMul(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Multiplication right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulMinus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionMinus;
+  R : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('2 * 3 - 4;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionMinus);
+  E:=TJSAdditiveExpressionMinus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSMultiplicativeExpressionMul);
+  R:=TJSMultiplicativeExpressionMul(E.A);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Multiplication right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('subtraction right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('subtraction right operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('subtraction right operand value correct', 4.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMinusMul;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionMinus;
+  R : TJSMultiplicativeExpressionMul;
+begin
+  CreateParser('4 - 2 * 3;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionMinus);
+  E:=TJSAdditiveExpressionMinus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSMultiplicativeExpressionMul);
+  R:=TJSMultiplicativeExpressionMul(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  AssertNotNull('Multiplication right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Multiplication right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Multiplication right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Subtraction left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Subtraction left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Subtraction left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceDivPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionDiv;
+begin
+  CreateParser('2 / 3 + 4;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSMultiplicativeExpressionDiv);
+  R:=TJSMultiplicativeExpressionDiv(E.A);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('Div left operand assigned',R.A);
+  AssertNotNull('Div right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Div left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Div left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Div right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Div right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Addition right operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Addition right operand value correct', 4.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusDiv;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionDiv;
+
+begin
+  CreateParser('4 + 2 / 3;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSMultiplicativeExpressionDiv);
+  R:=TJSMultiplicativeExpressionDiv(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Div left operand assigned',R.A);
+  AssertNotNull('Div right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Div left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Div left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Div right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Div right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceModPlus;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionMod;
+begin
+  CreateParser('2 % 3 + 4;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.A,TJSMultiplicativeExpressionMod);
+  R:=TJSMultiplicativeExpressionMod(E.A);
+  CheckClass(E.B,TJSLiteral);
+  AssertNotNull('mod left operand assigned',R.A);
+  AssertNotNull('mod right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('mod left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('mod left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('mod right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('mod right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.B).Value);
+  AssertEquals('Addition right operand type correct', jstNumber, TJSLiteral(E.B).Value.ValueType);
+  AssertEquals('Addition right operand value correct', 4.0,TJSLiteral(E.B).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusMod;
+
+Var
+  X : TJSExpressionStatement;
+  E : TJSAdditiveExpressionPlus;
+  R : TJSMultiplicativeExpressionMod;
+
+begin
+  CreateParser('4 + 2 % 3;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSMultiplicativeExpressionMod);
+  R:=TJSMultiplicativeExpressionMod(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Mod left operand assigned',R.A);
+  AssertNotNull('Mod right operand assigned',R.B);
+  CheckClass(R.A,TJSLiteral);
+  CheckClass(R.B,TJSLiteral);
+  AssertEquals('Mod left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Mod left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertEquals('Mod right operand type correct', jstNumber, TJSLiteral(R.B).Value.ValueType);
+  AssertEquals('Mod right operand value correct', 3.0, TJSLiteral(R.B).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusPostPlusPlus;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPostPlusPlusExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('4 + 2++;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPostPlusPlusExpression);
+  R:=TJSUnaryPostPlusPlusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('++ operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('++ operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('++ operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusPostMinusMinus;
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPostMinusMinusExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('4 + 2--;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPostMinusMinusExpression);
+  R:=TJSUnaryPostMinusMinusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('-- operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('-- operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('-- operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulPostPlusPlus;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPostPlusPlusExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * 2++;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPostPlusPlusExpression);
+  R:=TJSUnaryPostPlusPlusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('++operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('++ operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('++ operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Multiplication left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulPostMinusMinus;
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPostMinusMinusExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * 2--;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPostMinusMinusExpression);
+  R:=TJSUnaryPostMinusMinusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('-- operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('-- operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('-- operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Multiplication left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusPrePlusPlus;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPrePlusPlusExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('4 + ++2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPrePlusPlusExpression);
+  R:=TJSUnaryPrePlusPlusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('++ operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('++ operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusInv;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryInvExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+    CreateParser('4 + ~2;');
+    X:=GetExpressionStatement;
+    AssertNotNull('Expression statement assigned',X.A);
+    CheckClass(X.A,TJSAdditiveExpressionPlus);
+    E:=TJSAdditiveExpressionPlus(X.A);
+    AssertNotNull('Expression left operand assigned',E.A);
+    AssertNotNull('Expression right operand assigned',E.B);
+    CheckClass(E.B,TJSUnaryInvExpression);
+    R:=TJSUnaryInvExpression(E.B);
+    CheckClass(E.A,TJSLiteral);
+    AssertNotNull('Multiplication left operand assigned',R.A);
+    CheckClass(R.A,TJSLiteral);
+    AssertEquals('inv operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+    AssertEquals('inv operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+    AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+    AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+    AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulInv;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryInvExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * ~2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryInvExpression);
+  R:=TJSUnaryInvExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('Inv operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Inv operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Multiplication left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusNot;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryNotExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+    CreateParser('4 + !2;');
+    X:=GetExpressionStatement;
+    AssertNotNull('Expression statement assigned',X.A);
+    CheckClass(X.A,TJSAdditiveExpressionPlus);
+    E:=TJSAdditiveExpressionPlus(X.A);
+    AssertNotNull('Expression left operand assigned',E.A);
+    AssertNotNull('Expression right operand assigned',E.B);
+    CheckClass(E.B,TJSUnaryNotExpression);
+    R:=TJSUnaryNotExpression(E.B);
+    CheckClass(E.A,TJSLiteral);
+    AssertNotNull('Multiplication left operand assigned',R.A);
+    CheckClass(R.A,TJSLiteral);
+    AssertEquals('Not operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+    AssertEquals('Not operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+    AssertNotNull('Addition left operand value assigned',TJSLiteral(E.A).Value);
+    AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+    AssertEquals('Addition left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestFunctionCallNoArgs;
+
+Var
+  X : TJSExpressionStatement;
+  C : TJSCallExpression;
+
+begin
+  CreateParser('abc();');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSCallExpression);
+  C:=TJSCallExpression(X.A);
+  AssertEquals('No arguments',0,C.Args.Elements.Count);
+  AssertNotNull('Call function expression',C.Expr);
+  CheckClass(C.Expr,TJSPrimaryExpressionIdent);
+  AssertEquals('Function name correct','abc',TJSPrimaryExpressionIdent(C.Expr).Name);
+end;
+
+procedure TTestJSParser.TestFunctionCallOneArg;
+
+Var
+  X : TJSExpressionStatement;
+  C : TJSCallExpression;
+  E : TJSelement;
+
+begin
+  CreateParser('abc(d);');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSCallExpression);
+  C:=TJSCallExpression(X.A);
+  AssertNotNull('Call function expression',C.Expr);
+  CheckClass(C.Expr,TJSPrimaryExpressionIdent);
+  AssertEquals('Function name correct','abc',TJSPrimaryExpressionIdent(C.Expr).Name);
+  AssertEquals('1 argument',1,C.Args.Elements.Count);
+  E:=C.Args.Elements[0].Expr;
+  AssertNotNull('First argument expression',E);
+  CheckClass(E,TJSPrimaryExpressionIdent);
+  AssertEquals('First argument name correct','d',TJSPrimaryExpressionIdent(E).Name);
+end;
+
+procedure TTestJSParser.TestFunctionCallTwoArgs;
+
+Var
+  X : TJSExpressionStatement;
+  C : TJSCallExpression;
+  E : TJSelement;
+
+begin
+  CreateParser('abc(d,e);');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSCallExpression);
+  C:=TJSCallExpression(X.A);
+  AssertNotNull('Call function expression',C.Expr);
+  CheckClass(C.Expr,TJSPrimaryExpressionIdent);
+  AssertEquals('Function name correct','abc',TJSPrimaryExpressionIdent(C.Expr).Name);
+  AssertEquals('2 arguments',2,C.Args.Elements.Count);
+  E:=C.Args.Elements[0].Expr;
+  AssertNotNull('First argument expression',E);
+  CheckClass(E,TJSPrimaryExpressionIdent);
+  AssertEquals('First argument name correct','d',TJSPrimaryExpressionIdent(E).Name);
+  E:=C.Args.Elements[1].Expr;
+  AssertNotNull('Second argument expression',E);
+  CheckClass(E,TJSPrimaryExpressionIdent);
+  AssertEquals('Second argument name correct','e',TJSPrimaryExpressionIdent(E).Name);
+end;
+
+procedure TTestJSParser.TestArrayExpressionNumericalArgs;
+Var
+  X : TJSExpressionStatement;
+  B : TJSBracketMemberExpression;
+
+begin
+  CreateParser('A[1];');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSBracketMemberExpression);
+  B:=TJSBracketMemberExpression(X.A);
+  CheckClass(B.Name,TJSLiteral);
+  AssertEquals('Member name operand type correct', jstNumber, TJSLiteral(B.Name).Value.ValueType);
+  AssertEquals('Member name operand value correct', 1.0, TJSLiteral(B.Name).Value.AsNumber);
+  CheckClass(B.Mexpr,TJSPrimaryExpressionIdent);
+  AssertEquals('Array name correct','A',TJSPrimaryExpressionIdent(B.Mexpr).Name);
+end;
+
+procedure TTestJSParser.TestArrayExpressionStringArgs;
+Var
+  X : TJSExpressionStatement;
+  B : TJSBracketMemberExpression;
+
+begin
+  CreateParser('A["propname"];');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSBracketMemberExpression);
+  B:=TJSBracketMemberExpression(X.A);
+  CheckClass(B.Name,TJSLiteral);
+  AssertEquals('Member name operand type correct', jstString, TJSLiteral(B.Name).Value.ValueType);
+  AssertEquals('Member name operand value correct', 'propname', TJSLiteral(B.Name).Value.AsString);
+  CheckClass(B.Mexpr,TJSPrimaryExpressionIdent);
+  AssertEquals('Array name correct','A',TJSPrimaryExpressionIdent(B.Mexpr).Name);
+end;
+
+procedure TTestJSParser.TestArrayExpressionIdentArgs;
+
+Var
+  X : TJSExpressionStatement;
+  B : TJSBracketMemberExpression;
+
+begin
+  CreateParser('A[B];');
+  X:=GetExpressionStatement;
+  CheckClass(X.A,TJSBracketMemberExpression);
+  B:=TJSBracketMemberExpression(X.A);
+  CheckClass(B.Name,TJSPrimaryExpressionIdent);
+  AssertEquals('Member name identifier correct', 'B', TJSPrimaryExpressionIdent(B.Name).Name);
+  CheckClass(B.Mexpr,TJSPrimaryExpressionIdent);
+  AssertEquals('Array name correct','A',TJSPrimaryExpressionIdent(B.Mexpr).Name);
+end;
+
+Procedure TTestJSParser.TestVarDeclarationSimple;
+
+Var
+  X : TJSELement;
+  V : TJSVarDeclaration;
+begin
+  CreateParser('var a;');
+  X:=GetFirstVar;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+//  AssertNotNull('Variable statement assigned',(X));
+  AssertEquals('variable name correct registered', 'a', V.Name);
+  AssertNull('No initialization expression', V.Init);
+end;
+
+procedure TTestJSParser.TestVarDeclarationDouble;
+
+Var
+  X : TJSELement;
+  V : TJSVarDeclaration;
+
+begin
+  CreateParser('var a, b ;');
+  AssertEquals('2 variables declared',2,GetVars.Count);
+  X:=GetFirstVar;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+//  AssertNotNull('Variable statement assigned',(X));
+  AssertEquals('variable name correct registered', 'a', V.name);
+  X:=GetVars.Nodes[1].Node;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+  AssertEquals('variable name correct registered', 'b', V.Name);
+  AssertNull('No initialization expression', V.Init);
+end;
+
+procedure TTestJSParser.TestVarDeclarationSimpleInit;
+
+Var
+  X : TJSELement;
+  V : TJSVarDeclaration;
+begin
+  CreateParser('var a = b;');
+  X:=GetFirstVar;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+//  AssertNotNull('Variable statement assigned',(X));
+  AssertEquals('variable name correct registered', 'a', V.Name);
+  AssertNotNull('Initialization expression present', V.Init);
+  CheckClass(V.Init,TJSPrimaryExpressionIdent);
+  AssertEquals('Member name identifier correct', 'b', TJSPrimaryExpressionIdent(V.init).Name);
+end;
+
+procedure TTestJSParser.TestVarDeclarationDoubleInit;
+
+Var
+  X : TJSELement;
+  V : TJSVarDeclaration;
+begin
+  CreateParser('var a, c = b;');
+  AssertEquals('2 variables declared',2,GetVars.Count);
+  X:=GetFirstVar;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+//  AssertNotNull('Variable statement assigned',(X));
+  AssertEquals('variable name correct registered', 'a', V.Name);
+  AssertNull('No initialization expression', V.Init);
+  X:=GetVars.Nodes[1].Node;
+  CheckClass(X,TJSVarDeclaration);
+  V:=TJSVarDeclaration(X);
+  AssertEquals('variable name correct registered', 'c', V.Name);
+  AssertNotNull('No initialization expression', V.Init);
+  CheckClass(V.Init,TJSPrimaryExpressionIdent);
+  AssertEquals('Member name identifier correct', 'b', TJSPrimaryExpressionIdent(V.init).Name);
+end;
+
+procedure TTestJSParser.TestBlockEmpty;
+
+Var
+  E : TJSSourceElements;
+  X : TJSElement;
+
+begin
+  CreateParser('{}');
+  E:=GetSourceElements;
+  AssertEquals('1 statement in block',1,E.Statements.Count);
+  X:=E.Statements.Nodes[0].Node;
+  CheckClass(X,TJSEmptyBlockStatement);
+end;
+
+procedure TTestJSParser.TestBlockEmptyStatement;
+
+Var
+  E : TJSSourceElements;
+  X : TJSElement;
+
+begin
+  CreateParser('{;}');
+  E:=GetSourceElements;
+  AssertEquals('1 statement in block',1,E.Statements.Count);
+  X:=E.Statements.Nodes[0].Node;
+  CheckClass(X,TJSEmptyStatement);
+end;
+
+procedure TTestJSParser.TestBlockSimpleStatement;
+
+Var
+  E : TJSSourceElements;
+  X : TJSElement;
+
+begin
+  CreateParser('{a;}');
+  E:=GetSourceElements;
+  AssertEquals('1 statement in block',1,E.Statements.Count);
+  X:=E.Statements.Nodes[0].Node;
+  CheckClass(X,TJSExpressionStatement);
+  CheckNotNull(TJSExpressionStatement(X).A);
+  CheckClass(TJSExpressionStatement(X).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(X).A).Name)
+end;
+
+procedure TTestJSParser.TestFunctionDeclarationEmpty;
+
+Var
+  E : TJSSourceElements;
+  N : TJSElement;
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  CreateParser('function a () {}');
+  E:=GetSourceElements;
+  AssertEquals('1 function defined',1,E.functions.Count);
+  N:=E.Functions.Nodes[0].Node;
+  AssertNotNull('Function element defined ',N);
+  CheckClass(N,TJSFunctionDeclarationStatement);
+  FD:=TJSFunctionDeclarationStatement(N);
+  AssertNotNull('Function definition assigned',FD.AFunction);
+  AssertEquals('Function name OK','a',FD.AFunction.Name);
+  AssertNotNull('Function body assigned', FD.AFunction.Body);
+  AssertEquals('No parameters',0,FD.AFunction.Params.Count);
+  N:=FD.AFunction.Body;
+  CheckClass(N,TJSFunctionBody);
+  AssertNotNull('Function body has element',TJSFunctionBody(N).A);
+  CheckClass(TJSFunctionBody(N).A,  TJSSourceElements);
+  E:=TJSSourceElements(TJSFunctionBody(N).A);
+  AssertEquals('0 statement in functionbody elements',0,E.Statements.Count);
+//  TJSEmptyBlockStatement
+end;
+
+procedure TTestJSParser.TestFunctionDeclarationWithArgs;
+
+Var
+  E : TJSSourceElements;
+  N : TJSElement;
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  CreateParser('function a (b,c) {}');
+  E:=GetSourceElements;
+  AssertEquals('1 function defined',1,E.functions.Count);
+  N:=E.Functions.Nodes[0].Node;
+  AssertNotNull('Function element defined ',N);
+  CheckClass(N,TJSFunctionDeclarationStatement);
+  FD:=TJSFunctionDeclarationStatement(N);
+  AssertNotNull('Function definition assigned',FD.AFunction);
+  AssertEquals('Function name OK','a',FD.AFunction.Name);
+  AssertNotNull('Function body assigned', FD.AFunction.Body);
+  AssertEquals('2 parameters',2,FD.AFunction.Params.Count);
+  AssertEquals('1st parameter','b',FD.AFunction.Params[0]);
+  AssertEquals('2nd parameter','c',FD.AFunction.Params[1]);
+  N:=FD.AFunction.Body;
+  CheckClass(N,TJSFunctionBody);
+  AssertNotNull('Function body has element',TJSFunctionBody(N).A);
+  CheckClass(TJSFunctionBody(N).A,  TJSSourceElements);
+  E:=TJSSourceElements(TJSFunctionBody(N).A);
+  AssertEquals('0 statement in functionbody elements',0,E.Statements.Count);
+//  TJSEmptyBlockStatement
+end;
+
+procedure TTestJSParser.TestFunctionDeclarationWithBody;
+
+Var
+  E : TJSSourceElements;
+  N : TJSElement;
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  CreateParser('function a () { b; }');
+  E:=GetSourceElements;
+  AssertEquals('1 function defined',1,E.functions.Count);
+  N:=E.Functions.Nodes[0].Node;
+  AssertNotNull('Function element defined ',N);
+  CheckClass(N,TJSFunctionDeclarationStatement);
+  FD:=TJSFunctionDeclarationStatement(N);
+  AssertNotNull('Function definition assigned',FD.AFunction);
+  AssertEquals('Function name OK','a',FD.AFunction.Name);
+  AssertNotNull('Function body assigned', FD.AFunction.Body);
+  AssertEquals('2 parameters',0,FD.AFunction.Params.Count);
+  N:=FD.AFunction.Body;
+  CheckClass(N,TJSFunctionBody);
+  AssertNotNull('Function body has element',TJSFunctionBody(N).A);
+  CheckClass(TJSFunctionBody(N).A,  TJSSourceElements);
+  E:=TJSSourceElements(TJSFunctionBody(N).A);
+  AssertEquals('1 statement in functionbody elements',1,E.Statements.Count);
+  N:=E.Statements.Nodes[0].Node;
+  CheckClass(N,TJSExpressionStatement);
+  CheckNotNull(TJSExpressionStatement(N).A);
+  CheckClass(TJSExpressionStatement(N).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(N).A).Name);
+//  TJSEmptyBlockStatement
+end;
+
+procedure TTestJSParser.TestIfSimple;
+
+Var
+  E : TJSElement;
+  I : TJSIfStatement;
+
+begin
+  CreateParser('if (a) b;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSIfStatement);
+  I:=TJSIfStatement(E);
+  AssertNotNull('Statement condition assigned',I.Cond);
+  CheckClass(I.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(I.Cond).Name);
+  AssertNull('Statement false branch assigned',I.BFalse);
+  AssertNotNull('Statement true branch assigned',I.Btrue);
+  CheckClass(I.Btrue,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(I.BTrue).A);
+  CheckClass(TJSExpressionStatement(I.BTrue).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(I.Btrue).A).Name);
+end;
+
+procedure TTestJSParser.TestIfEmptyBlock;
+
+Var
+  E : TJSElement;
+  I : TJSIfStatement;
+
+begin
+  CreateParser('if (a) {}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSIfStatement);
+  I:=TJSIfStatement(E);
+  AssertNotNull('Statement condition assigned',I.Cond);
+  CheckClass(I.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(I.Cond).Name);
+  AssertNull('Statement false branch assigned',I.BFalse);
+  AssertNotNull('Statement true branch assigned',I.Btrue);
+  CheckClass(I.Btrue,TJSEmptyBlockStatement);
+end;
+
+procedure TTestJSParser.TestIfEmptyBlockElse;
+
+Var
+  E : TJSElement;
+  I : TJSIfStatement;
+
+begin
+  CreateParser('if (a) {} else b;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSIfStatement);
+  I:=TJSIfStatement(E);
+  AssertNotNull('Statement condition assigned',I.Cond);
+  CheckClass(I.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(I.Cond).Name);
+  AssertNotNull('Statement false branch assigned',I.BFalse);
+  AssertNotNull('Statement true branch assigned',I.Btrue);
+  CheckClass(I.Btrue,TJSEmptyBlockStatement);
+end;
+
+procedure TTestJSParser.TestWhileSimple;
+Var
+  E : TJSElement;
+  W : TJSWhileStatement;
+
+begin
+  CreateParser('while (a) b;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSWhileStatement);
+  W:=TJSWhileStatement(E);
+  AssertNotNull('Statement condition assigned',W.Cond);
+  CheckClass(W.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(W.Cond).Name);
+  AssertNotNull('Statement condition assigned',W.body);
+  CheckClass(W.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(W.Body).A);
+  CheckClass(TJSExpressionStatement(W.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(W.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestWhileBlock;
+
+Var
+  E : TJSElement;
+  W : TJSWhileStatement;
+//  B : TJSBlockStatement;
+
+begin
+  CreateParser('while (a) {b;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSWhileStatement);
+  W:=TJSWhileStatement(E);
+  AssertNotNull('Statement condition assigned',W.Cond);
+  CheckClass(W.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(W.Cond).Name);
+  AssertNotNull('Statement condition assigned',W.body);
+  CheckClass(W.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(W.Body).A);
+  CheckClass(TJSExpressionStatement(W.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(W.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestDoWhileSimple;
+
+Var
+  E : TJSElement;
+  W : TJSDoWhileStatement;
+//  B : TJSBlockStatement;
+
+begin
+  CreateParser('do b; while (a);');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSDoWhileStatement);
+  W:=TJSDoWhileStatement(E);
+  AssertNotNull('Statement condition assigned',W.Cond);
+  CheckClass(W.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(W.Cond).Name);
+  AssertNotNull('Statement condition assigned',W.body);
+  CheckClass(W.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(W.Body).A);
+  CheckClass(TJSExpressionStatement(W.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(W.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestDoWhileBlock;
+
+Var
+  E : TJSElement;
+  W : TJSDoWhileStatement;
+//  B : TJSBlockStatement;
+
+begin
+  CreateParser('do {b;} while (a);');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSDoWhileStatement);
+  W:=TJSDoWhileStatement(E);
+  AssertNotNull('Statement condition assigned',W.Cond);
+  CheckClass(W.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(W.Cond).Name);
+  AssertNotNull('Statement condition assigned',W.body);
+  CheckClass(W.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(W.Body).A);
+  CheckClass(TJSExpressionStatement(W.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(W.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestForEmpty;
+
+Var
+  E : TJSElement;
+  F : TJSForStatement;
+
+begin
+  CreateParser('for (;;) a;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSForStatement);
+  F:=TJSForStatement(E);
+  AssertNull('Statement condition not assigned',F.Cond);
+  AssertNull('Statement init not assigned',F.Init);
+  AssertNull('Statement step not assigned',F.Incr);
+  CheckClass(F.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(F.Body).A);
+  CheckClass(TJSExpressionStatement(F.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(F.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestForEmptyBody;
+
+Var
+  E : TJSElement;
+  F : TJSForStatement;
+
+begin
+  CreateParser('for (;;) {a;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSForStatement);
+  F:=TJSForStatement(E);
+  AssertNull('Statement condition not assigned',F.Cond);
+  AssertNull('Statement init not assigned',F.Init);
+  AssertNull('Statement step not assigned',F.Incr);
+  CheckClass(F.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(F.Body).A);
+  CheckClass(TJSExpressionStatement(F.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(F.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestForSimpleBody;
+
+Var
+  E : TJSElement;
+  F : TJSForStatement;
+
+begin
+  CreateParser('for (a;b;c) {d;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSForStatement);
+  F:=TJSForStatement(E);
+  AssertNotNull('Statement condition not assigned',F.Cond);
+  AssertNotNull('Statement init not assigned',F.Init);
+  AssertNotNull('Statement step not assigned',F.Incr);
+  CheckClass(F.Init,TJSPrimaryExpressionIdent);
+  AssertNotNull('Expression statement expression',TJSPrimaryExpressionIdent(F.Init));
+  AssertEquals('a',TJSPrimaryExpressionIdent(F.Init).Name);
+  CheckClass(F.Incr,TJSPrimaryExpressionIdent);
+  AssertNotNull('Expression statement expression',TJSPrimaryExpressionIdent(F.Incr));
+  AssertEquals('c',TJSPrimaryExpressionIdent(F.Incr).Name);
+  CheckClass(F.Cond,TJSPrimaryExpressionIdent);
+  AssertNotNull('Expression statement expression',TJSPrimaryExpressionIdent(F.Cond));
+  AssertEquals('b',TJSPrimaryExpressionIdent(F.cond).Name);
+  CheckClass(F.Body,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(F.Body).A);
+  CheckClass(TJSExpressionStatement(F.Body).A,TJSPrimaryExpressionIdent);
+  AssertEquals('d',TJSPrimaryExpressionIdent(TJSExpressionStatement(F.Body).A).Name);
+end;
+
+procedure TTestJSParser.TestTryCatch;
+
+Var
+  E : TJSElement;
+  T : TJSTryCatchStatement;
+
+begin
+  CreateParser('try {a;} catch (e) {b;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSTryCatchStatement);
+  T:=TJSTryCatchStatement(E);
+  CheckClass(T.Block,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.Block).A);
+  CheckClass(TJSExpressionStatement(T.Block).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.Block).A).Name);
+  CheckClass(T.BCatch,TJSExpressionStatement);
+  AssertEquals('Except object identifier name','e',T.Ident);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.BCatch).A);
+  CheckClass(TJSExpressionStatement(T.BCatch).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.BCatch).A).Name);
+  AssertNull('No Finally expression',T.BFinally);
+end;
+
+procedure TTestJSParser.TestTryCatchFinally;
+
+Var
+  E : TJSElement;
+  T : TJSTryCatchFinallyStatement;
+
+begin
+  CreateParser('try {a;} catch (e) {b;} finally {c;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSTryCatchFinallyStatement);
+  T:=TJSTryCatchFinallyStatement(E);
+  CheckClass(T.Block,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.Block).A);
+  CheckClass(TJSExpressionStatement(T.Block).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.Block).A).Name);
+  AssertEquals('Except object identifier name','e',T.Ident);
+  CheckClass(T.BCatch,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.BCatch).A);
+  CheckClass(TJSExpressionStatement(T.BCatch).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.BCatch).A).Name);
+  AssertNotNull('Finally expression',T.BFinally);
+  CheckClass(T.BFinally,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.BFinally).A);
+  CheckClass(TJSExpressionStatement(T.BFinally).A,TJSPrimaryExpressionIdent);
+  AssertEquals('c',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.BFinally).A).Name);
+end;
+
+procedure TTestJSParser.TestTryFinally;
+
+Var
+  E : TJSElement;
+  T : TJSTryFinallyStatement;
+
+begin
+  CreateParser('try {a;} finally {c;}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSTryFinallyStatement);
+  T:=TJSTryFinallyStatement(E);
+  CheckClass(T.Block,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(T.Block).A);
+  CheckClass(TJSExpressionStatement(T.Block).A,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.Block).A).Name);
+  AssertNull('No catch',T.BCatch);
+  AssertNotNull('Finally expression',T.BFinally);
+  AssertNotNull('Finally expression',TJSExpressionStatement(T.BFinally).A);
+  CheckClass(TJSExpressionStatement(T.BFinally).A,TJSPrimaryExpressionIdent);
+  AssertEquals('c',TJSPrimaryExpressionIdent(TJSExpressionStatement(T.BFinally).A).Name);
+end;
+
+procedure TTestJSParser.TestThrow;
+Var
+  E : TJSElement;
+  T : TJSThrowStatement;
+
+begin
+  CreateParser('throw a;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSThrowStatement);
+  T:=TJSThrowStatement(E);
+  AssertNotNull('Have throw object',T.A);
+  CheckClass(T.A,TJSPrimaryExpressionIdent);
+  AssertEquals('Correct identifier','a',TJSPrimaryExpressionIdent(T.A).Name);
+end;
+
+procedure TTestJSParser.TestReturn;
+
+Var
+  E : TJSSourceElements;
+  N : TJSElement;
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  CreateParser('function a () { return b; }');
+  E:=GetSourceElements;
+  AssertEquals('1 function defined',1,E.functions.Count);
+  N:=E.Functions.Nodes[0].Node;
+  AssertNotNull('Function element defined ',N);
+  CheckClass(N,TJSFunctionDeclarationStatement);
+  FD:=TJSFunctionDeclarationStatement(N);
+  AssertNotNull('Function definition assigned',FD.AFunction);
+  AssertEquals('Function name OK','a',FD.AFunction.Name);
+  AssertNotNull('Function body assigned', FD.AFunction.Body);
+  AssertEquals('No parameters',0,FD.AFunction.Params.Count);
+  N:=FD.AFunction.Body;
+  CheckClass(N,TJSFunctionBody);
+  AssertNotNull('Function body has element',TJSFunctionBody(N).A);
+  CheckClass(TJSFunctionBody(N).A,  TJSSourceElements);
+  E:=TJSSourceElements(TJSFunctionBody(N).A);
+  AssertEquals('1 statement in functionbody elements',1,E.Statements.Count);
+end;
+
+procedure TTestJSParser.TestAssignment;
+Var
+  E : TJSElement;
+  ES : TJSExpressionStatement;
+  A : TJSSimpleAssignStatement;
+
+begin
+  CreateParser('a=b;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSExpressionStatement);
+  ES:=TJSExpressionStatement(E);
+  CheckClass(ES.A,TJSSimpleAssignStatement);
+  A:=TJSSimpleAssignStatement(ES.A);
+  AssertNotNull('Have LHS',A.LHS);
+  CheckClass(A.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Have LHS name','a',TJSPrimaryExpressionIdent(A.LHS).Name);
+  CheckClass(A.Expr,TJSPrimaryExpressionIdent);
+  AssertEquals('Have RHS name','b',TJSPrimaryExpressionIdent(A.Expr).Name);
+end;
+
+procedure TTestJSParser.TestNew;
+Var
+  E : TJSElement;
+  ES : TJSExpressionStatement;
+  A : TJSSimpleAssignStatement;
+  N : TJSNewMemberExpression;
+  L : TJSLiteral;
+
+begin
+  CreateParser('a = new b(123)');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSExpressionStatement);
+  ES:=TJSExpressionStatement(E);
+  CheckClass(ES.A,TJSSimpleAssignStatement);
+  A:=TJSSimpleAssignStatement(ES.A);
+  CheckClass(A.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Have LHS name','a',TJSPrimaryExpressionIdent(A.LHS).Name);
+  CheckClass(A.Expr,TJSNewMemberExpression);
+  N:=TJSNewMemberExpression(A.Expr);
+  AssertNotNull('Have LHS name',N.Mexpr);
+  CheckClass(N.Mexpr,TJSPrimaryExpressionIdent);
+  AssertEquals('Have LHS name','b',TJSPrimaryExpressionIdent(N.Mexpr).Name);
+  AssertNotNull('Have arguments',N.Args);
+  AssertEquals('One argument',1,N.Args.Elements.Count);
+  AssertNotNull('Have argument 0',N.Args.Elements[0].Expr);
+  CheckClass(N.Args.Elements[0].Expr,TJSLiteral);
+  L:=TJSLiteral(N.Args.Elements[0].Expr);
+  AssertNotNull('Expression value assigned',L.Value);
+  AssertEquals('Expression value type correct', jstNumber,L.Value.ValueType);
+  AssertEquals('Expression value correct', 123,L.Value.AsNumber);
+
+end;
+
+procedure TTestJSParser.TestLabeledStatement;
+Var
+  E : TJSElement;
+  ES : TJSExpressionStatement;
+  A : TJSSimpleAssignStatement;
+  N : TJSNewMemberExpression;
+  L : TJSLiteral;
+  LS : TJSLabeledStatement;
+
+begin
+  CreateParser('loc: a = new b(123)');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSLabeledStatement);
+  LS:=TJSLabeledStatement(E);
+  AssertNotNull('Have label',LS.TheLabel);
+  AssertEquals('Have correct label','loc',LS.TheLabel.Name);
+  CheckClass(LS.A,TJSExpressionStatement);
+  ES:=TJSExpressionStatement(LS.A);
+  CheckClass(ES.A,TJSSimpleAssignStatement);
+  A:=TJSSimpleAssignStatement(ES.A);
+  CheckClass(A.LHS,TJSPrimaryExpressionIdent);
+  AssertEquals('Have LHS name','a',TJSPrimaryExpressionIdent(A.LHS).Name);
+  CheckClass(A.Expr,TJSNewMemberExpression);
+  N:=TJSNewMemberExpression(A.Expr);
+  AssertNotNull('Have LHS name',N.Mexpr);
+  CheckClass(N.Mexpr,TJSPrimaryExpressionIdent);
+  AssertEquals('Have LHS name','b',TJSPrimaryExpressionIdent(N.Mexpr).Name);
+  AssertNotNull('Have arguments',N.Args);
+  AssertEquals('One argument',1,N.Args.Elements.Count);
+  AssertNotNull('Have argument 0',N.Args.Elements[0].Expr);
+  CheckClass(N.Args.Elements[0].Expr,TJSLiteral);
+  L:=TJSLiteral(N.Args.Elements[0].Expr);
+  AssertNotNull('Expression value assigned',L.Value);
+  AssertEquals('Expression value type correct', jstNumber,L.Value.ValueType);
+  AssertEquals('Expression value correct', 123,L.Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestContinue;
+
+Var
+  E : TJSElement;
+  C : TJSContinueStatement;
+
+begin
+  CreateParser('while (true) continue;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSWhileStatement);
+  E:=TJSWhileStatement(E).Body;
+  CheckClass(E,TJSContinueStatement);
+  C:=TJSContinueStatement(E);
+  AssertEquals('Have correct (empty) label','',C.TargetName);
+end;
+
+procedure TTestJSParser.TestContinueTarget;
+
+Var
+  E : TJSElement;
+  C : TJSContinueStatement;
+
+begin
+  CreateParser('a: while (true) continue a;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSLabeledStatement);
+  E:=TJSLabeledStatement(E).A;
+  CheckClass(E,TJSWhileStatement);
+  E:=TJSWhileStatement(E).Body;
+  CheckClass(E,TJSContinueStatement);
+  C:=TJSContinueStatement(E);
+  AssertEquals('Have correct  label','a',C.TargetName);
+end;
+
+procedure TTestJSParser.TestBreakTarget;
+Var
+  E : TJSElement;
+  C : TJSBreakStatement;
+
+begin
+  CreateParser('a: while (true) break a;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSLabeledStatement);
+  E:=TJSLabeledStatement(E).A;
+  CheckClass(E,TJSWhileStatement);
+  E:=TJSWhileStatement(E).Body;
+  CheckClass(E,TJSBreakStatement);
+  C:=TJSBreakStatement(E);
+  AssertEquals('Have correct  label','a',C.TargetName);
+end;
+
+procedure TTestJSParser.TestSwitchEmpty;
+Var
+  E : TJSElement;
+  S : TJSSwitchStatement;
+begin
+  CreateParser('switch (a) {}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSSwitchStatement);
+  S:=TJSSwitchStatement(E);
+  AssertNotNull('Have condition',S.Cond);
+  AssertNull('Have no default',S.TheDefault);
+  AssertIdentifier('Case condition',S.Cond,'a');
+  S:=TJSSwitchStatement(E);
+  AssertEquals('No cases',0,S.Cases.Count)
+end;
+
+procedure TTestJSParser.TestSwitchOne;
+Var
+  E : TJSElement;
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  CreateParser('switch (a) { case c : {}}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSSwitchStatement);
+  S:=TJSSwitchStatement(E);
+  AssertNotNull('Have condition',S.Cond);
+  AssertNull('Have no default',S.TheDefault);
+  AssertIdentifier('Case condition',S.Cond,'a');
+  S:=TJSSwitchStatement(E);
+  AssertEquals('1 case',1,S.Cases.Count);
+  C:=TJSCaseElement(S.Cases[0]);
+  AssertIdentifier('Case expression',C.Expr,'c');
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+end;
+
+procedure TTestJSParser.TestSwitchTwo;
+Var
+  E : TJSElement;
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  CreateParser('switch (a) { case c: {}'+sLineBreak+' case d: {}}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSSwitchStatement);
+  S:=TJSSwitchStatement(E);
+  AssertNotNull('Have condition',S.Cond);
+  AssertNull('Have no default',S.TheDefault);
+  AssertIdentifier('Case condition',S.Cond,'a');
+  S:=TJSSwitchStatement(E);
+  AssertEquals('2 cases',2,S.Cases.Count);
+  C:=TJSCaseElement(S.Cases[0]);
+  AssertIdentifier('Case expression',C.Expr,'c');
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+  C:=TJSCaseElement(S.Cases[1]);
+  AssertIdentifier('Case expression',C.Expr,'d');
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+end;
+
+procedure TTestJSParser.TestSwitchTwoDefault;
+Var
+  E : TJSElement;
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  CreateParser('switch (a) { case c: {} case d: {} default: {}}');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSSwitchStatement);
+  S:=TJSSwitchStatement(E);
+  AssertNotNull('Have condition',S.Cond);
+  AssertNotNull('Have default',S.TheDefault);
+  AssertIdentifier('Case condition',S.Cond,'a');
+  S:=TJSSwitchStatement(E);
+  AssertEquals('2 cases',3,S.Cases.Count);
+  C:=TJSCaseElement(S.Cases[0]);
+  AssertIdentifier('Case expression',C.Expr,'c');
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+  C:=TJSCaseElement(S.Cases[1]);
+  AssertIdentifier('Case expression',C.Expr,'d');
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+  C:=TJSCaseElement(S.Cases[2]);
+  CheckClass(C.Body,TJSEmptyBlockStatement);
+  AssertSame('Default',C,S.TheDefault);
+end;
+
+procedure TTestJSParser.TestBreak;
+Var
+  E : TJSElement;
+  C : TJSBreakStatement;
+
+begin
+  CreateParser('while (true) break;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSWhileStatement);
+  E:=TJSWhileStatement(E).Body;
+  CheckClass(E,TJSBreakStatement);
+  C:=TJSBreakStatement(E);
+  AssertEquals('Have correct (empty) label','',C.TargetName);
+end;
+
+procedure TTestJSParser.TestIfElseSimple;
+
+Var
+  E : TJSElement;
+  I : TJSIfStatement;
+
+begin
+  CreateParser('if (a) b; else c;');
+  E:=GetFirstStatement;
+  CheckClass(E,TJSIfStatement);
+  I:=TJSIfStatement(E);
+  AssertNotNull('Statement condition assigned',I.Cond);
+  CheckClass(I.Cond,TJSPrimaryExpressionIdent);
+  AssertEquals('a',TJSPrimaryExpressionIdent(I.Cond).Name);
+  AssertNotNull('Statement condition assigned',I.Btrue);
+  CheckClass(I.Btrue,TJSExpressionStatement);
+  AssertNotNull('Expression statement expression',TJSExpressionStatement(I.BTrue).A);
+  CheckClass(TJSExpressionStatement(I.BTrue).A,TJSPrimaryExpressionIdent);
+  AssertEquals('b',TJSPrimaryExpressionIdent(TJSExpressionStatement(I.Btrue).A).Name);
+  AssertNotNull('Else Statement condition assigned',I.BFalse);
+  CheckClass(I.BFalse,TJSExpressionStatement);
+  AssertNotNull('Else statement expression',TJSExpressionStatement(I.BFalse).A);
+  CheckClass(TJSExpressionStatement(I.BFalse).A,TJSPrimaryExpressionIdent);
+  AssertEquals('c',TJSPrimaryExpressionIdent(TJSExpressionStatement(I.BFalse).A).Name);
+end;
+
+
+procedure TTestJSParser.TestExpressionPrecedenceMulNot;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryNotExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * !2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryNotExpression);
+  R:=TJSUnaryNotExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('Not operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Not operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Multiplication left operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedencePlusPreMinusMinus;
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPreMinusMinusExpression;
+  E : TJSAdditiveExpressionPlus;
+
+begin
+  CreateParser('4 + --2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSAdditiveExpressionPlus);
+  E:=TJSAdditiveExpressionPlus(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPreMinusMinusExpression);
+  R:=TJSUnaryPreMinusMinusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulPrePlusPlus;
+
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPrePlusPlusExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * ++2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPrePlusPlusExpression);
+  R:=TJSUnaryPrePlusPlusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestExpressionPrecedenceMulPreMinusMinus;
+Var
+  X : TJSExpressionStatement;
+  R : TJSUnaryPreMinusMinusExpression;
+  E : TJSMultiplicativeExpressionMul;
+
+begin
+  CreateParser('4 * --2;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSMultiplicativeExpressionMul);
+  E:=TJSMultiplicativeExpressionMul(X.A);
+  AssertNotNull('Expression left operand assigned',E.A);
+  AssertNotNull('Expression right operand assigned',E.B);
+  CheckClass(E.B,TJSUnaryPreMinusMinusExpression);
+  R:=TJSUnaryPreMinusMinusExpression(E.B);
+  CheckClass(E.A,TJSLiteral);
+  AssertNotNull('Multiplication left operand assigned',R.A);
+  CheckClass(R.A,TJSLiteral);
+  AssertEquals('Multiplication left operand type correct', jstNumber, TJSLiteral(R.A).Value.ValueType);
+  AssertEquals('Multiplication left operand value correct', 2.0, TJSLiteral(R.A).Value.AsNumber);
+  AssertNotNull('Addition right operand value assigned',TJSLiteral(E.A).Value);
+  AssertEquals('Addition left operand type correct', jstNumber, TJSLiteral(E.A).Value.ValueType);
+  AssertEquals('Expression right operand value correct', 4.0,TJSLiteral(E.A).Value.AsNumber);
+end;
+
+procedure TTestJSParser.TestSimpleExpressionBooleanLiteralTrue;
+
+Var
+  X : TJSExpressionStatement;
+
+begin
+  CreateParser('true;');
+  X:=GetExpressionStatement;
+  AssertNotNull('Expression statement assigned',X.A);
+  CheckClass(X.A,TJSLiteral);
+  AssertNotNull('Expression value assigned',TJSLiteral(X.A).Value);
+  AssertEquals('Expression value type correct', jstBoolean,TJSLiteral(X.A).Value.ValueType);
+  AssertEquals('Expression value correct', True, TJSLiteral(X.A).Value.AsBoolean);
+end;
+
+
+procedure TTestJSParser.TestEmpty;
+
+Var
+  E : TJSElement;
+  FB : TJSFunctionBody;
+  SE : TJSSourceElements;
+
+begin
+  CreateParser('var a;');
+  E:=FParser.Parse;
+  try
+    CheckClass(E,TJSFunctionBody);
+    FB:=TJSFunctionBody(E);
+    AssertNotNull(FB.A);
+    CheckClass(FB.A,TJSSourceElements);
+    SE:=TJSSourceElements(FB.A);
+    AssertEquals('1 variable declaration ',1,SE.Vars.Count);
+    CheckClass(FB.A,TJSSourceElements);
+  finally
+    E.Free;
+  end;
+end;
+
+procedure TTestJSParser.SetUp; 
+begin
+  FParser:=Nil;
+  FSource:=Nil;
+end; 
+
+procedure TTestJSParser.TearDown; 
+begin
+  FreeAndNil(FToFree);
+  FreeAndNil(FParser);
+  FReeAndNil(FSource);
+end;
+
+Procedure TTestJSParser.CreateParser(Const ASource: string);
+begin
+  FSource:=TStringStream.Create(ASource);
+  FParser:=TJSParser.Create(FSource);
+end;
+
+Procedure TTestJSParser.CheckClass(E: TJSElement; C: TJSElementClass);
+begin
+  AssertEquals(C,E.ClassType);
+end;
+
+Function TTestJSParser.GetSourceElements: TJSSourceElements;
+
+Var
+  E : TJSElement;
+  FB : TJSFunctionBody;
+
+begin
+  If Not Assigned(FSE) then
+    begin
+    AssertNotNull('Parser assigned',FParser);
+    E:=FParser.Parse;
+    CheckClass(E,TJSFunctionBody);
+    FB:=TJSFunctionBody(E);
+    AssertNotNull(FB.A);
+    CheckClass(FB.A,TJSSourceElements);
+    FSE:=TJSSourceElements(FB.A);
+    FToFree:=E;
+    end;
+  Result:=FSE;
+end;
+
+Function TTestJSParser.GetVars: TJSElementNodes;
+begin
+  Result:=GetSourceElements.Vars;
+end;
+
+Function TTestJSParser.GetStatements: TJSElementNodes;
+begin
+  Result:=GetSourceElements.Statements;
+end;
+
+Function TTestJSParser.GetFunctions: TJSElementNodes;
+begin
+  Result:=GetSourceElements.Functions;
+end;
+
+
+initialization
+
+  RegisterTest(TTestJSParser); 
+end.
+

+ 995 - 0
compiler/packages/fcl-js/tests/tcscanner.pp

@@ -0,0 +1,995 @@
+unit tcscanner;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Typinfo, fpcunit, testregistry, jstoken, jsscanner;
+
+type
+
+  { TTestLineReader }
+
+  TTestLineReader = Class(TTestCase)
+  Private
+    FData: TStringStream;
+    FReader : TStreamLineReader;
+  protected
+    Procedure CreateReader(AInput : String);
+    procedure TearDown; override;
+  published
+    Procedure TestEmpty;
+    Procedure TestReadLine;
+    Procedure TestReadLines13;
+    Procedure TestReadLines10;
+    Procedure TestReadLines1310;
+    procedure TestReadLinesEOF13;
+    procedure TestReadLinesEOF10;
+    procedure TestReadLinesEOF1310;
+    procedure TestReadEmptyLines101010;
+  end;
+
+  { TTestJSScanner }
+
+  TTestJSScanner = class(TTestCase)
+  Private
+    FStream : TStream;
+    FLineReader : TLineReader;
+    FScanner : TJSScanner;
+    FErrorSource : String;
+    procedure AssertEquals(AMessage: String; AExpected, AActual : TJSToken); overload;
+    procedure CheckToken(AToken: TJSToken; ASource: String);
+    procedure CheckTokens(ASource: String; ATokens: array of TJSToken);
+    procedure DoTestFloat(F: Double);
+    procedure DoTestFloat(F: Double; S: String);
+    procedure DoTestString(S: String);
+    procedure TestErrorSource;
+  protected
+    Function CreateScanner(AInput : String) : TJSScanner;
+    procedure FreeScanner;
+    procedure SetUp; override;
+    procedure TearDown; override;
+
+    Property Scanner : TJSScanner Read FScanner;
+  published
+    Procedure TestEmpty;
+    procedure TestAndAnd;
+    procedure TestAndEq;
+    procedure TestAssign;
+    procedure TestBraceClose;
+    procedure TestBraceOpen;
+    procedure TestColon;
+    procedure TestComma;
+    procedure TestCurlyBraceClose;
+    procedure TestCurlyBraceOpen;
+    procedure TestDiv;
+    procedure TestDiveq;
+    procedure TestXor;
+    procedure TestXoreq;
+    procedure TestDot;
+    procedure TestEq;
+    procedure TestGE;
+    procedure TestFalse;
+    procedure TestInv;
+    procedure TestNot;
+    procedure TestString;
+    procedure TestTrue;
+    procedure TestGreaterThan;
+    procedure TestLE;
+    procedure TestLessThan;
+    procedure TestLSHIFT;
+    procedure TestLSHIFTEQ;
+    procedure TestMinus;
+    procedure TestMinusEQ;
+    procedure TestMinusMinus;
+    procedure TestModeq;
+    procedure TestMul;
+    procedure TestNE;
+    procedure TestNSE;
+    procedure TestOREQ;
+    procedure TestOROR;
+    procedure TestPlus;
+    procedure TestPlusEq;
+    procedure TestPlusPlus;
+    procedure TestRShift;
+    procedure TestRShiftEq;
+    procedure TestSemicolon;
+    procedure TestSEq;
+    procedure TestSquaredBraceClose;
+    procedure TestSquaredBraceOpen;
+    procedure TestStarEq;
+    procedure TestURShift;
+    procedure TestURShiftEq;
+    procedure TestBreak;
+    procedure TestCase;
+    procedure TestCatch;
+    procedure TestContinue;
+    procedure TestDefault;
+    procedure TestDelete;
+    procedure TestDO;
+    procedure TestElse;
+    procedure TestFinally;
+    procedure TestFor;
+    procedure TestFunction;
+    procedure TestIf;
+    procedure TestIn;
+    procedure TestInstanceOf;
+    procedure TestNew;
+    procedure TestReturn;
+    procedure TestSwitch;
+    procedure TestThis;
+    procedure TestThrow;
+    procedure TestTry;
+    procedure TestTypeOf;
+    procedure TestVar;
+    procedure TestVoid;
+    procedure TestWhile;
+    procedure TestWith;
+    Procedure Test2Words;
+    procedure Test3Words;
+    procedure TestIdentifier;
+    procedure TestIdentifier2;
+    procedure TestIdentifier3;
+    procedure TestIdentifier4;
+    procedure TestIdentifier5;
+    procedure TestIdentifierDotIdentifier;
+    procedure TestEOLN;
+    procedure TestEOLN2;
+    procedure TestEOLN3;
+    procedure TestEOLN4;
+    procedure TestComment1;
+    procedure TestComment2;
+    procedure TestComment3;
+    procedure TestComment4;
+    procedure TestComment5;
+    procedure TestComment6;
+    procedure TestFloat;
+    procedure TestStringError;
+    procedure TestFloatError;
+  end;
+
+
+implementation
+
+Function TTestJSScanner.CreateScanner(AInput : String) : TJSScanner;
+
+begin
+  FStream:=TStringStream.Create(AInput);
+  FLineReader:=TStreamLineReader.Create(Fstream);
+  FScanner:=TJSScanner.Create(FLineReader);
+  Result:=FScanner;
+end;
+
+procedure TTestJSScanner.FreeScanner;
+begin
+  FreeAndNil(FScanner);
+  FreeAndNil(FLineReader);
+  FreeAndNil(FStream);
+end;
+
+procedure TTestJSScanner.SetUp;
+begin
+  inherited SetUp;
+end;
+
+
+
+procedure TTestJSScanner.TestEmpty;
+
+Var
+  J : TJSToken;
+
+begin
+  CreateScanner('');
+  J:=Scanner.FetchToken;
+  If (J<>tjsEOF) then
+    Fail('Empty returns EOF');
+end;
+
+procedure TTestJSScanner.AssertEquals(AMessage : String; AExpected, AActual: TJSToken);
+
+Var
+  S,EN1,EN2 : String;
+
+begin
+  If (AActual<>AExpected) then
+    begin
+    EN1:=GetEnumName(TypeINfo(TJSToken),Ord(AExpected));
+    EN2:=GetEnumName(TypeINfo(TJSToken),Ord(AActual));
+    S:=Format('%s : %s <> %s',[AMessage,EN1,EN2]);
+    Fail(S);
+    end;
+end;
+
+procedure TTestJSScanner.CheckToken(AToken : TJSToken; ASource : String);
+
+Var
+  J : TJSToken;
+  EN2 : String;
+
+begin
+  CreateScanner(ASource);
+  J:=Scanner.FetchToken;
+  EN2:=GetEnumName(TypeINfo(TJSToken),Ord(AToken));
+  AssertEquals(Format('Source %s should result in %s.',[ASource,EN2]),AToken,J);
+end;
+
+
+procedure TTestJSScanner.TestAndAnd;
+
+begin
+  CheckToken(tjsAndAnd,'&&');
+end;
+
+procedure TTestJSScanner.TestAndEq;
+
+begin
+  CheckToken(tjsAndEq,'&=');
+end;
+
+procedure TTestJSScanner.TestBraceOpen;
+
+begin
+  CheckToken(tjsBraceOpen,'(');
+end;
+
+procedure TTestJSScanner.TestBraceClose;
+
+begin
+  CheckToken(tjsBraceClose,')');
+end;
+
+procedure TTestJSScanner.TestSquaredBraceClose;
+
+begin
+  CheckToken(tjsSquaredBraceClose,']');
+end;
+
+procedure TTestJSScanner.TestSquaredBraceOpen;
+
+begin
+  CheckToken(tjssQuaredBraceOpen,'[');
+end;
+
+procedure TTestJSScanner.TestCurlyBraceOpen;
+
+begin
+  CheckToken(tjsCurlyBraceOpen,'{');
+end;
+
+procedure TTestJSScanner.TestCurlyBraceClose;
+
+begin
+  CheckToken(tjsCurlyBraceClose,'}');
+end;
+
+procedure TTestJSScanner.TestComma;
+
+begin
+  CheckToken(tjsComma,',');
+end;
+
+procedure TTestJSScanner.TestColon;
+
+begin
+  CheckToken(tjsColon,':');
+end;
+
+procedure TTestJSScanner.TestDot;
+
+begin
+  CheckToken(tjsDot,'.');
+end;
+
+procedure TTestJSScanner.TestSemicolon;
+
+begin
+  CheckToken(tjsSemicolon,';');
+end;
+
+procedure TTestJSScanner.TestAssign;
+
+begin
+  CheckToken(tjsAssign,'=');
+end;
+
+procedure TTestJSScanner.TestGreaterThan;
+
+begin
+  CheckToken(tjsGT,'>');
+end;
+
+procedure TTestJSScanner.TestLessThan;
+
+begin
+  CheckToken(tjsLT,'<');
+end;
+
+procedure TTestJSScanner.TestPlus;
+
+begin
+  CheckToken(tjsPlus,'+');
+end;
+
+procedure TTestJSScanner.TestMinus;
+
+begin
+  CheckToken(tjsMinus,'-');
+end;
+
+procedure TTestJSScanner.TestMul;
+
+begin
+  CheckToken(tjsMul,'*');
+end;
+
+procedure TTestJSScanner.TestDiv;
+
+begin
+  CheckToken(tjsDiv,'/');
+end;
+
+procedure TTestJSScanner.TestEq;
+
+begin
+  CheckToken(tjsEq,'==');
+end;
+
+procedure TTestJSScanner.TestGE;
+
+begin
+  CheckToken(tjsGE,'>=');
+end;
+
+procedure TTestJSScanner.TestLE;
+
+begin
+  CheckToken(tjsLE,'<=');
+end;
+
+procedure TTestJSScanner.TestLSHIFT;
+
+begin
+  CheckToken(tjsLShift,'<<');
+end;
+
+procedure TTestJSScanner.TestLSHIFTEQ;
+
+begin
+  CheckToken(tjsLShiftEq,'<<=');
+end;
+
+procedure TTestJSScanner.TestMinusEQ;
+
+begin
+  CheckToken(tjsMinusEq,'-=');
+end;
+
+procedure TTestJSScanner.TestMinusMinus;
+
+begin
+  CheckToken(tjsMinusMinus,'--');
+end;
+
+procedure TTestJSScanner.TestModeq;
+
+begin
+  CheckToken(tjsModeq,'%=');
+end;
+
+
+procedure TTestJSScanner.TestDiveq;
+
+begin
+  CheckToken(tjsDiveq,'/=');
+end;
+
+procedure TTestJSScanner.TestXor;
+begin
+  CheckToken(tjsXOR,'^');
+end;
+
+procedure TTestJSScanner.TestXoreq;
+begin
+  CheckToken(tjsXOREQ,'^=');
+end;
+
+procedure TTestJSScanner.TestNE;
+
+begin
+  CheckToken(tjsNE,'!=');
+end;
+
+procedure TTestJSScanner.TestInv;
+
+begin
+  CheckToken(tjsInv,'~');
+end;
+
+procedure TTestJSScanner.TestNot;
+
+begin
+  CheckToken(tjsNot,'!');
+end;
+
+procedure TTestJSScanner.TestTrue;
+
+begin
+  CheckToken(tjsTrue,'true');
+end;
+
+procedure TTestJSScanner.TestFalse;
+
+begin
+  CheckToken(tjsFalse,'false');
+end;
+
+procedure TTestJSScanner.TestOREQ;
+
+begin
+  CheckToken(tjsOREQ,'|=');
+end;
+
+procedure TTestJSScanner.TestOROR;
+
+begin
+  CheckToken(tjsOROR,'||');
+end;
+
+procedure TTestJSScanner.TestPlusEq;
+
+begin
+  CheckToken(tjsPlusEq,'+=');
+end;
+
+procedure TTestJSScanner.TestPlusPlus;
+
+begin
+  CheckToken(tjsPlusPlus,'++');
+end;
+
+procedure TTestJSScanner.TestURShift;
+
+begin
+  CheckToken(tjsURSHIFT,'>>>');
+end;
+
+procedure TTestJSScanner.TestURShiftEq;
+
+begin
+  CheckToken(tjsURSHIFTEQ,'>>>=');
+end;
+
+procedure TTestJSScanner.TestRShift;
+
+begin
+  CheckToken(tjsRSHIFT,'>>');
+end;
+
+procedure TTestJSScanner.TestRShiftEq;
+
+begin
+  CheckToken(tjsRSHIFTEQ,'>>=');
+end;
+
+procedure TTestJSScanner.TestSEq;
+
+begin
+  CheckToken(tjsSEQ,'===');
+end;
+
+procedure TTestJSScanner.TestNSE;
+
+begin
+  CheckToken(tjsSNE,'!==');
+end;
+
+procedure TTestJSScanner.TestStarEq;
+
+begin
+  CheckToken(tjsMulEq,'*=');
+end;
+
+procedure TTestJSScanner.TestBreak;
+
+begin
+  CheckToken(tjsBreak,'break');
+end;
+
+procedure TTestJSScanner.TestCase;
+
+begin
+  CheckToken(tjscase,'case');
+end;
+
+procedure TTestJSScanner.TestCatch;
+
+begin
+  CheckToken(tjscatch,'catch');
+end;
+
+procedure TTestJSScanner.TestContinue;
+
+begin
+  CheckToken(tjscontinue,'continue');
+end;
+
+procedure TTestJSScanner.TestDefault;
+
+begin
+  CheckToken(tjsdefault,'default');
+end;
+
+procedure TTestJSScanner.TestDelete;
+
+begin
+  CheckToken(tjsdelete,'delete');
+end;
+
+procedure TTestJSScanner.TestDO;
+
+begin
+  CheckToken(tjsdo,'do');
+end;
+
+procedure TTestJSScanner.TestElse;
+
+begin
+  CheckToken(tjselse,'else');
+end;
+
+procedure TTestJSScanner.TestFinally;
+
+begin
+  CheckToken(tjsfinally,'finally');
+end;
+
+procedure TTestJSScanner.TestFor;
+
+begin
+  CheckToken(tjsfor,'for');
+end;
+
+procedure TTestJSScanner.TestFunction;
+
+begin
+  CheckToken(tjsfunction,'function');
+end;
+
+procedure TTestJSScanner.TestIf;
+
+begin
+  CheckToken(tjsif,'if');
+end;
+
+procedure TTestJSScanner.TestIn;
+
+begin
+  CheckToken(tjsin,'in');
+end;
+
+procedure TTestJSScanner.TestInstanceOf;
+
+begin
+  CheckToken(tjsinstanceof,'instanceof');
+end;
+
+procedure TTestJSScanner.TestNew;
+
+begin
+  CheckToken(tjsnew,'new');
+end;
+
+procedure TTestJSScanner.TestReturn;
+
+begin
+  CheckToken(tjsreturn,'return');
+end;
+
+procedure TTestJSScanner.TestSwitch;
+
+begin
+  CheckToken(tjsswitch,'switch');
+end;
+
+procedure TTestJSScanner.TestThis;
+
+begin
+  CheckToken(tjsThis,'this');
+end;
+
+procedure TTestJSScanner.TestThrow;
+
+begin
+  CheckToken(tjsThrow,'throw');
+end;
+
+procedure TTestJSScanner.TestTry;
+
+begin
+  CheckToken(tjsTry,'try');
+end;
+
+procedure TTestJSScanner.TestTypeOf;
+
+begin
+  CheckToken(tjstypeof,'typeof');
+end;
+
+procedure TTestJSScanner.TestVar;
+
+begin
+  CheckToken(tjsvar,'var');
+end;
+
+procedure TTestJSScanner.TestVoid;
+
+begin
+  CheckToken(tjsvoid,'void');
+end;
+
+procedure TTestJSScanner.TestWhile;
+
+begin
+  CheckToken(tjswhile,'while');
+end;
+
+procedure TTestJSScanner.TestWith;
+
+begin
+  CheckToken(tjswith,'with');
+end;
+
+procedure TTestJSScanner.CheckTokens(ASource : String; ATokens : Array of TJSToken);
+
+Var
+  I : Integer;
+  J : TJSToken;
+  S : String;
+
+begin
+  CreateScanner(ASource);
+  For I:=Low(ATokens) to High(ATokens) do
+    begin
+    J:=FScanner.FetchToken;
+    S:=GetEnumName(TypeINfo(TJSToken),Ord(ATokens[i]));
+    S:=Format('Source "%s", token %d (%s): expected %s',[ASource,I,FScanner.CurTokenString,S]);
+    AssertEquals(S,ATokens[i],J);
+    end;
+end;
+
+procedure TTestJSScanner.Test2Words;
+begin
+  CheckTokens('with do',[tjsWith,tjsDo]);
+end;
+
+procedure TTestJSScanner.Test3Words;
+begin
+  CheckTokens('with do for',[tjsWith,tjsDo,tjsFor]);
+end;
+
+procedure TTestJSScanner.TestIdentifier;
+begin
+  CheckToken(tjsIdentifier,'something');
+  AssertEquals('Correct identifier','something',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestIdentifier2;
+begin
+  CheckToken(tjsIdentifier,'_something');
+  AssertEquals('Correct identifier','_something',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestIdentifier3;
+begin
+  CheckToken(tjsIdentifier,'$');
+  AssertEquals('Correct identifier','$',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestIdentifier4;
+begin
+  CheckToken(tjsIdentifier,'_0');
+  AssertEquals('Correct identifier','_0',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestIdentifier5;
+begin
+  CheckToken(tjsIdentifier,'$0');
+  AssertEquals('Correct identifier','$0',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestIdentifierDotIdentifier;
+begin
+  CheckTokens('something.different',[tjsIdentifier,tjsdot,tjsIdentifier]);
+//  AssertEquals('Correct identifier','something',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestEOLN;
+begin
+  CreateScanner('something');
+  FScanner.FetchToken;
+  AssertEquals('Got to end of line after reading single token at EOF',True,FScanner.IsEndOfLine);
+//  AssertEquals('Correct identifier','something',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestEOLN2;
+begin
+  CreateScanner('something different');
+  FScanner.FetchToken;
+  AssertEquals('Not yet end of line after reading single token at EOF',False,FScanner.IsEndOfLine);
+end;
+
+procedure TTestJSScanner.TestEOLN3;
+begin
+  CreateScanner('something'#13#10'different');
+  FScanner.FetchToken;
+  AssertEquals('End of line after reading single token',True,FScanner.IsEndOfLine);
+end;
+
+procedure TTestJSScanner.TestEOLN4;
+begin
+  CreateScanner('something'#10'different');
+  FScanner.FetchToken;
+  AssertEquals('End of line after reading first token',True,FScanner.IsEndOfLine);
+  FScanner.FetchToken;
+  AssertEquals('End of line after reading second token',True,FScanner.IsEndOfLine);
+end;
+
+procedure TTestJSScanner.TestComment1;
+begin
+  CreateScanner('// some comment string');
+  AssertEquals('Comment line is skipped',tjsEOF,FScanner.FetchToken);
+end;
+
+procedure TTestJSScanner.TestComment2;
+begin
+  CreateScanner('// some comment string');
+  FScanner.ReturnComments:=True;
+  AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
+  AssertEquals('Comment contents is returned',' some comment string',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestComment3;
+begin
+  CreateScanner('/* some comment string */');
+  AssertEquals('Comment line is skipped',tjsEOF,FScanner.FetchToken);
+end;
+
+procedure TTestJSScanner.TestComment4;
+begin
+  CreateScanner('/* some comment string */');
+  FScanner.ReturnComments:=True;
+  AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
+  AssertEquals('Comment contents is returned',' some comment string ',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestComment5;
+begin
+  CreateScanner('/* some nested comment // string */');
+  FScanner.ReturnComments:=True;
+  AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
+  AssertEquals('Comment contents is returned',' some nested comment // string ',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TestComment6;
+begin
+  CreateScanner('// /* some nested comment string */');
+  FScanner.ReturnComments:=True;
+  AssertEquals('Comment line is returned',tjsComment,FScanner.FetchToken);
+  AssertEquals('Comment contents is returned',' /* some nested comment string */',FScanner.CurTokenString);
+end;
+
+procedure TTestJSScanner.TearDown; 
+begin
+  FreeScanner;
+  Inherited;
+end;
+
+procedure TTestJSScanner.DoTestFloat(F : Double);
+
+Var
+  S : String;
+
+begin
+  Str(F,S);
+  DoTestFloat(F,S);
+end;
+
+procedure TTestJSScanner.DoTestFloat(F : Double; S : String);
+
+Var
+  J : TJSToken;
+  C : Double;
+  I : integer;
+  V : String;
+
+begin
+  CreateScanner(S);
+  try
+    J:=FScanner.FetchToken;
+    AssertEquals(S+' is a number',tjsNumber,J);
+    V:=FScanner.CurTokenString;
+    If (Copy(V,1,2)='0x') then
+      begin
+      Flush(output);
+      V:='$'+Copy(V,3,Length(V)-2);
+      C:=StrToInt(V);
+      end
+    else
+      begin
+      Val(V,C,I);
+      If (I<>0) then
+        Fail(FScanner.CurTokenString+' does not contain a float value');
+      end;
+    AssertEquals('Parsed float equals original float',F,C);
+  finally
+    FreeScanner;
+  end;
+end;
+
+procedure TTestJSScanner.TestFloat;
+
+
+begin
+  DoTestFloat(1.2);
+  DoTestFloat(-1.2);
+  DoTestFloat(0);
+  DoTestFloat(1.2e1);
+  DoTestFloat(-1.2e1);
+  DoTestFloat(0);
+  DoTestFloat(1.2,'1.2');
+  DoTestFloat(-1.2,'-1.2');
+  DoTestFloat(0,'0.0');
+  DoTestFloat(255,'0xff')
+end;
+
+procedure TTestJSScanner.TestFloatError;
+
+begin
+  FErrorSource:='1xz';
+  AssertException('Wrong float',EJSScannerError,@TestErrorSource);
+end;
+
+
+procedure TTestJSScanner.DoTestString(S: String);
+
+Var
+  J : TJSToken;
+begin
+  CreateScanner(S);
+  try
+    J:=FScanner.FetchToken;
+    AssertEquals(S+' is a string',tjsString,J);
+    If (Length(S)>0) and (S[1] in ['"','''']) then
+      S:=Copy(S,2,Length(S)-2);
+    AssertEquals('Correct string is returned',S,FScanner.CurTokenString);
+  finally
+    FreeScanner;
+  end;
+end;
+
+procedure TTestJSScanner.TestString;
+
+begin
+  DoTestString('"A string"');
+  DoTestString('""');
+  DoTestString('''''');
+  DoTestString('''A string''');
+end;
+
+procedure TTestJSScanner.TestErrorSource;
+
+begin
+  CreateScanner(FErrorSource);
+  try
+    While (FScanner.FetchToken<>tjsEOF) do ;
+  finally
+    FreeScanner;
+  end;
+end;
+
+procedure TTestJSScanner.TestStringError;
+
+begin
+  FErrorSource:='"A string';
+  AssertException('Unterminated string',EJSScannerError,@TestErrorSource);
+  FErrorSource:='''A string';
+  AssertException('Unterminated string',EJSScannerError,@TestErrorSource);
+end;
+
+
+{ TTestLineReader }
+
+procedure TTestLineReader.CreateReader(AInput: String);
+begin
+  FData:=TStringStream.Create(AInput);
+  FReader:=TStreamLineReader.Create(FData);
+end;
+
+
+procedure TTestLineReader.TearDown;
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(FData);
+end;
+
+procedure TTestLineReader.TestEmpty;
+begin
+  CreateReader('');
+  AssertEquals('Empty reader returns EOF',True,FReader.IsEOF);
+  AssertEquals('Empty reader returns empty string','',FReader.ReadLine);
+end;
+
+procedure TTestLineReader.TestReadLine;
+begin
+  CreateReader('Something');
+  AssertEquals('Reader with 1 line returns 1 line','Something',FReader.ReadLine);
+  AssertEquals('EOF true after reading line',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLines13;
+begin
+  CreateReader('Something'#13'else');
+  AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLines10;
+begin
+  CreateReader('Something'#10'else');
+  AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLines1310;
+begin
+  CreateReader('Something'#13#10'else');
+  AssertEquals('Reader with 2 lines returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 2 lines returns 2nd line','else',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLinesEOF13;
+begin
+  CreateReader('Something'#13);
+  AssertEquals('Reader with 2 lines + CR returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 1 lines + CR returns empty 2nd line','',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLinesEOF10;
+begin
+  CreateReader('Something'#10);
+  AssertEquals('Reader with 2 lines + LF returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 1 lines + LF returns empty 2nd line','',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadLinesEOF1310;
+begin
+  CreateReader('Something'#13#10);
+  AssertEquals('Reader with 2 lines + CRLF returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('Reader with 1 lines + CRLF returns empty 2nd line','',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+procedure TTestLineReader.TestReadEmptyLines101010;
+
+begin
+  CreateReader('Something'#10#10#10);
+  AssertEquals('Reader with 1 line + LFLFLF returns 1st line','Something',FReader.ReadLine);
+  AssertEquals('EOF false after reading line 1',False,FReader.IsEOF);
+  AssertEquals('Reader with 1 line + LFLFLF returns empty 2nd line','',FReader.ReadLine);
+  AssertEquals('EOF false after reading line 2',False,FReader.IsEOF);
+  AssertEquals('Reader with 1 line + LFLFLF returns empty 3nd line','',FReader.ReadLine);
+  AssertEquals('EOF true after reading lines',True,FReader.IsEOF);
+end;
+
+initialization
+
+  RegisterTests([TTestLineReader,TTestJSScanner]);
+end.
+

+ 175 - 0
compiler/packages/fcl-js/tests/tcsrcmap.pas

@@ -0,0 +1,175 @@
+unit TCSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, JSSrcMap;
+
+type
+
+  { TCustomTestSrcMap }
+
+  TCustomTestSrcMap = class(TTestCase)
+  protected
+    procedure CheckEl(aName: String; El: TJSONData; aClass: TClass);
+    function GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+  end;
+
+  { TTestSrcMap }
+
+  TTestSrcMap = class(TCustomTestSrcMap)
+  published
+    procedure Test_Base64VLQ;
+    procedure TestSrcMapIgnoreDuplicate;
+    procedure TestSrcMapNames;
+  end;
+
+implementation
+
+{ TCustomTestSrcMap }
+
+procedure TCustomTestSrcMap.CheckEl(aName: String; El: TJSONData; aClass: TClass);
+begin
+  AssertNotNull('json "'+aName+'" exists',El);
+  AssertEquals('json "'+aName+'" class',El.ClassType,aClass);
+end;
+
+function TCustomTestSrcMap.GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+begin
+  Result:=Obj.Elements[aName];
+  CheckEl(aName,Result,aClass);
+end;
+
+{ TTestSrcMap }
+
+procedure TTestSrcMap.Test_Base64VLQ;
+var
+  i: Integer;
+  s: String;
+  p: PChar;
+  j: NativeInt;
+begin
+  for i:=-511 to 511 do
+  begin
+    s:=EncodeBase64VLQ(i);
+    p:=PChar(s);
+    j:=DecodeBase64VLQ(p);
+    if i<>j then
+      Fail('Encode/DecodeBase64VLQ OrigIndex='+IntToStr(i)+' Code="'+s+'" NewIndex='+IntToStr(j));
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapIgnoreDuplicate;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,0,'a.js',1,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(3,0,'a.js',2,0);
+
+    //writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: [],
+      mappings: 'AAAA;A;AACA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,0);
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'AAAA;A;AACA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapNames;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,1,'a.js',2,2,'foo');
+    sm.AddMapping(3,3,'a.js',4,4,'foo');
+    writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: ['foo'],
+      mappings: 'CACEA;;GAEEA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('names[0]',El,TJSONString);
+    AssertEquals('json "names[0]" value',El.AsString,'foo');
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'CACEA;;GAEEA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+initialization
+  RegisterTests([TTestSrcMap]);
+end.
+

+ 2732 - 0
compiler/packages/fcl-js/tests/tcwriter.pp

@@ -0,0 +1,2732 @@
+unit tcwriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, jsbase, jstree, jswriter;
+
+type
+
+  { TTestJSWriter }
+
+  TTestJSWriter = class(TTestCase)
+  private
+    FElement: TJSElement;
+    FTextWriter: TBufferWriter;
+    FWriter: TJSWriter;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure WriteElement(JS : TJSElement); // Set element in Element, write. Freed on teardown
+    Procedure AssertResult(Const Msg, Result : String); // Compare result;
+    Procedure AssertResult(Const Msg : string; Result : UnicodeString); // Compare result;
+    Procedure AssertWrite(Const Msg, Result : String; AElement : TJSElement); // Call writelement, compare result;
+    Procedure AssertWrite(Const Msg : string; Result : UnicodeString; AElement : TJSElement); // Call writelement, compare result;
+    Function CreateIdent(Const AName : String) : TJSPrimaryExpressionIdent;
+    Function CreateLiteral(Const AValue : TJSString) : TJSLiteral;
+    Function CreateLiteral(Const AValue : Integer) : TJSLiteral;
+    Function CreateLiteral(Const AValue : Boolean) : TJSLiteral;
+    Property TextWriter : TBufferWriter Read FTextWriter;
+    Property Writer : TJSWriter Read FWriter;
+    Property Element : TJSElement read FElement;
+  end;
+
+  TTestTestJSWriter = Class(TTestJSWriter)
+  published
+    procedure TestEmpty;
+  end;
+
+  { TTestLiteralWriter }
+
+  TTestLiteralWriter= class(TTestJSWriter)
+  published
+    Procedure TestInteger;
+    Procedure TestBooleanTrue;
+    Procedure TestBooleanFalse;
+    Procedure TestUndefined;
+    Procedure TestNull;
+    Procedure TestString;
+    Procedure TestStringQuote;
+    Procedure TestStringBackslash;
+    Procedure TestStringslash;
+    Procedure TestStringsBack;
+    Procedure TestStringsTab;
+    Procedure TestStringsLineFeed;
+    Procedure TestStringsFormFeed;
+    Procedure TestStringsCarriageReturn;
+    Procedure TestArrayEmpty;
+    Procedure TestArrayEmptyCompact;
+    Procedure TestArrayOneElement;
+    Procedure TestArrayOneElementCompact;
+    Procedure TestArrayOneElementIndent;
+    Procedure TestArrayTwoElements;
+    Procedure TestArrayTwoElementsCompact;
+    Procedure TestArrayTwoElementsCompact2;
+    Procedure TestArrayThreeElementsCompact;
+    Procedure TestObjectEmpty;
+    Procedure TestObjectEmptyCompact;
+    Procedure TestObjectOneElement;
+    Procedure TestObjectOneElementCompact;
+    Procedure TestObjectOneElementIndent;
+    Procedure TestObjectOneElementCompactQuoted;
+    Procedure TestObjectTwoElements;
+    Procedure TestObjectTwoElementCompact;
+    Procedure TestObjectTwoElementCompact2;
+    Procedure TestObjectTwoElementCompactQuoted;
+    Procedure TestObjectThreeElementsCompact;
+  end;
+
+  { TTestStatementWriter }
+
+  TTestStatementWriter = class(TTestJSWriter)
+  Public
+    Procedure TestAssignment(Const Msg : String; AClass : TJSAssignStatementClass; Result : String;ACompact : Boolean);
+    Function CreateAssignment(AClass : TJSAssignStatementClass) : TJSAssignStatement;
+    Function CreateStatementListOneElement : TJSStatementList;
+    Function CreateStatementListTwoElement2 : TJSStatementList;
+  published
+    Procedure TestEmptyStatement;
+    Procedure TestEmptyStatementComment;
+    Procedure TestEmptyStatementBlock;
+    Procedure TestEmptyStatementBlockIndent;
+    Procedure TestEmptyStatementBlockCompact;
+    Procedure TestVarDeclaration;
+    Procedure TestVarDeclarationInit;
+    Procedure TestVarListDeclaration;
+    Procedure TestVarListDeclarationInit;
+    Procedure TestVarDeclarationStatement;
+    Procedure TestVarListDeclarationStatement;
+    Procedure TestVarListDeclarationStatement2Vars;
+    Procedure TestVarListDeclarationStatement3Vars;
+    Procedure TestReturnStatement;
+    Procedure TestLabeledStatement;
+    Procedure TestLabeledStatementCompact;
+    Procedure TestContinueStatement;
+    Procedure TestContinueTargetStatement;
+    Procedure TestBreakStatement;
+    Procedure TestBreakTargetStatement;
+    Procedure TestAssignmentStatementSimple;
+    Procedure TestAssignmentStatementSimpleCompact;
+    Procedure TestAssignmentStatementAdd;
+    Procedure TestAssignmentStatementAddCompact;
+    Procedure TestAssignmentStatementSubtract;
+    Procedure TestAssignmentStatementSubtractCompact;
+    Procedure TestAssignmentStatementMultiply;
+    Procedure TestAssignmentStatementMultiplyCompact;
+    Procedure TestAssignmentStatementDivide;
+    Procedure TestAssignmentStatementDivideCompact;
+    Procedure TestAssignmentStatementShift;
+    Procedure TestAssignmentStatementShiftCompact;
+    Procedure TestAssignmentStatementRShift;
+    Procedure TestAssignmentStatementRShiftCompact;
+    Procedure TestAssignmentStatementURShift;
+    Procedure TestAssignmentStatementURShiftCompact;
+    Procedure TestAssignmentStatementMod;
+    Procedure TestAssignmentStatementModCompact;
+    Procedure TestAssignmentStatementBinaryOr;
+    Procedure TestAssignmentStatementBinaryOrCompact;
+    Procedure TestAssignmentStatementBinaryXOr;
+    Procedure TestAssignmentStatementBinaryXOrCompact;
+    Procedure TestAssignmentStatementBinaryAnd;
+    Procedure TestAssignmentStatementBinaryAndCompact;
+    Procedure TestForStatementEmpty;
+    Procedure TestForStatementFull;
+    Procedure TestForStatementFull1;
+    Procedure TestForStatementCompact;
+    Procedure TestForStatement2loops2inits;
+    Procedure TestForInStatement;
+    Procedure TestWhileStatement;
+    Procedure TestDoWhileStatement;
+    Procedure TestSwitchStatementEmpty;
+    Procedure TestSwitchStatementEmptyCompact;
+    Procedure TestSwitchStatementOneElement;
+    Procedure TestSwitchStatementOneElementCompact;
+    Procedure TestSwitchStatementTwoElements;
+    Procedure TestSwitchStatementTwoElementsCompact;
+    Procedure TestSwitchStatementTwoElementsDefault;
+    Procedure TestSwitchStatementTwoElementsDefaultCompact;
+    Procedure TestSwitchStatementTwoElementsOneEmpty;
+    Procedure TestSwitchStatementTwoElementsOneEmptyCompact;
+    Procedure TestIfThen;
+    Procedure TestIfThenElse;
+    Procedure TestStatementListEmpty;
+    Procedure TestStatementListEmptyCompact;
+    Procedure TestStatementListOneStatement;
+    Procedure TestStatementListOneStatementCompact;
+    Procedure TestStatementListTwoStatements;
+    Procedure TestStatementListTwoStatementsCompact;
+    Procedure TestStatementListFor;
+    Procedure TestEmptyFunctionDef;
+    Procedure TestEmptyFunctionDefCompact;
+    Procedure TestFunctionDefParams;
+    Procedure TestFunctionDefParamsCompact;
+    Procedure TestFunctionDefBody1;
+    Procedure TestFunctionDefBody1Compact;
+    Procedure TestFunctionDefBody2;
+    Procedure TestFunctionDefBody2Compact;
+    Procedure TestTryCatch;
+    Procedure TestTryCatchCompact;
+    Procedure TestTryFinally;
+    Procedure TestTryFinallyCompact;
+    Procedure TestTryCatchFinally;
+    Procedure TestTryCatchFinallyCompact;
+    Procedure TestWith;
+    Procedure TestWithCompact;
+    Procedure TestSourceElements;
+    Procedure TestSourceElementsCompact;
+  end;
+
+  { TTestExpressionWriter }
+
+  TTestExpressionWriter = class(TTestJSWriter)
+  Protected
+    Procedure TestUnary(Const Msg : String; AClass : TJSUnaryClass; Result : String);
+    Procedure TestBinary(Const Msg : String; AClass : TJSBinaryClass; Result : String; ACompact : Boolean);
+    Procedure TestBinaryNested(Const Msg : String; AClass : TJSBinaryClass; Result : String; ACompact : Boolean);
+  Published
+    Procedure TestIdent;
+    Procedure TestThis;
+    Procedure TestThrowStatement;
+    Procedure TestUnaryDelete;
+    Procedure TestUnaryVoid;
+    Procedure TestUnaryTypeOf;
+    Procedure TestPrefixPlusPLus;
+    Procedure TestPrefixMinusMinus;
+    Procedure TestUnaryMinus;
+    Procedure TestUnaryPlus;
+    Procedure TestUnaryInv;
+    Procedure TestUnaryNot;
+    Procedure TestPostPlusPLus;
+    Procedure TestPostMinusMinus;
+    Procedure TestBinaryLogicalOr;
+    Procedure TestBinaryLogicalOrCompact;
+    Procedure TestBinaryLogicalOrNested;
+    Procedure TestBinaryLogicalAnd;
+    Procedure TestBinaryLogicalAndCompact;
+    Procedure TestBinaryLogicalAndNested;
+    Procedure TestBinaryBitwiseOr;
+    Procedure TestBinaryBitwiseOrCompact;
+    Procedure TestBinaryBitwiseAnd;
+    Procedure TestBinaryBitwiseAndCompact;
+    Procedure TestBinaryBitwiseXOr;
+    Procedure TestBinaryBitwiseXOrCompact;
+    Procedure TestBinaryEQ;
+    Procedure TestBinaryEQCompact;
+    Procedure TestBinaryNE;
+    Procedure TestBinaryNECompact;
+    Procedure TestBinarySEQ;
+    Procedure TestBinarySEQCompact;
+    Procedure TestBinarySNE;
+    Procedure TestBinarySNECompact;
+    Procedure TestBinaryLT;
+    Procedure TestBinaryLTCompact;
+    Procedure TestBinaryGT;
+    Procedure TestBinaryGTCompact;
+    Procedure TestBinaryLE;
+    Procedure TestBinaryLECompact;
+    Procedure TestBinaryGE;
+    Procedure TestBinaryGECompact;
+    Procedure TestBinaryIN;
+    Procedure TestBinaryINCompact;
+    Procedure TestBinaryInstanceOf;
+    Procedure TestBinaryInstanceOfCompact;
+    Procedure TestBinaryLShift;
+    Procedure TestBinaryLShiftOfCompact;
+    Procedure TestBinaryRShift;
+    Procedure TestBinaryRShiftOfCompact;
+    Procedure TestBinaryURShift;
+    Procedure TestBinaryURShiftOfCompact;
+    Procedure TestBinaryPlus;
+    Procedure TestBinaryPlusCompact;
+    Procedure TestBinaryPlusNested;
+    Procedure TestBinaryMinus;
+    Procedure TestBinaryMinusCompact;
+    Procedure TestBinaryMinusNested;
+    Procedure TestBinaryMultiply;
+    Procedure TestBinaryMultiplyCompact;
+    Procedure TestBinaryMultiplyNested;
+    Procedure TestBinaryDivide;
+    Procedure TestBinaryDivideCompact;
+    Procedure TestBinaryMod;
+    Procedure TestBinaryModCompact;
+    Procedure TestBinaryComma;
+    Procedure TestBinaryCommaCompact;
+    Procedure TestBinaryCallDiv;
+    Procedure TestDotMember;
+    Procedure TestArgMember;
+    Procedure TestNewMember;
+    Procedure TestNewMemberCompact;
+    Procedure TestNewMemberNoArgs;
+    Procedure TestCall;
+    Procedure TestCallCompact;
+    Procedure TestCallCompact2;
+    Procedure TestCallNoArgs;
+    Procedure TestConditional;
+    Procedure TestRegularExpressionLiteral;
+    Procedure TestRegularExpressionLiteralFlags;
+  end;
+
+implementation
+
+{ TTestExpressionWriter }
+
+procedure TTestExpressionWriter.TestUnary(const Msg: String;
+  AClass: TJSUnaryClass; Result: String);
+Var
+  U : TJSUnary;
+
+begin
+  U:=AClass.Create(0,0);
+  U.A:=CreateIdent('a');
+  AssertWrite(Msg,Result,U);
+end;
+
+procedure TTestExpressionWriter.TestBinary(const Msg: String;
+  AClass: TJSBinaryClass; Result: String; ACompact: Boolean);
+Var
+  U : TJSBinary;
+
+begin
+  if ACompact then
+    Writer.Options:=Writer.Options+[woCompact];
+  U:=AClass.Create(0,0);
+  U.A:=CreateIdent('a');
+  U.B:=CreateIdent('b');
+  AssertWrite(Msg,Result,U);
+end;
+
+procedure TTestExpressionWriter.TestBinaryNested(const Msg: String;
+  AClass: TJSBinaryClass; Result: String; ACompact: Boolean);
+var
+  U: TJSBinary;
+begin
+  if ACompact then
+    Writer.Options:=Writer.Options+[woCompact];
+  U:=AClass.Create(0,0);
+  U.A:=AClass.Create(0,0);
+  TJSBinary(U.A).A:=CreateIdent('a');
+  TJSBinary(U.A).B:=CreateIdent('b');
+  U.B:=AClass.Create(0,0);
+  TJSBinary(U.B).A:=CreateIdent('c');
+  TJSBinary(U.B).B:=CreateIdent('d');
+  AssertWrite(Msg,Result,U);
+end;
+
+procedure TTestExpressionWriter.TestIdent;
+
+begin
+  AssertWrite('ABC','ABC',CreateIdent('ABC'));
+end;
+
+procedure TTestExpressionWriter.TestThis;
+begin
+  AssertWrite('this','this',TJSPrimaryExpressionThis.Create(0,0));
+end;
+
+procedure TTestExpressionWriter.TestThrowStatement;
+
+begin
+  TestUnary('Throw expresssion',TJSThrowStatement,'throw a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryDelete;
+begin
+  TestUnary('Delete expresssion',TJSUnaryDeleteExpression,'delete a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryVoid;
+begin
+  TestUnary('Void expresssion',TJSUnaryVoidExpression,'void a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryTypeOf;
+begin
+  TestUnary('typeof expresssion',TJSUnaryTypeOfExpression,'typeof a');
+end;
+
+procedure TTestExpressionWriter.TestPrefixPlusPLus;
+begin
+  TestUnary('prefix ++ expresssion',TJSUnaryPrePlusPlusExpression,'++a');
+end;
+
+procedure TTestExpressionWriter.TestPrefixMinusMinus;
+begin
+  TestUnary('prefix -- expresssion',TJSUnaryPreMinusMinusExpression,'--a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryMinus;
+begin
+  TestUnary('unary - expresssion',TJSUnaryMinusExpression,'-a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryPlus;
+begin
+  TestUnary('unary + expresssion',TJSUnaryPlusExpression,'+a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryInv;
+begin
+  TestUnary('unary invert expresssion',TJSUnaryInvExpression,'~a');
+end;
+
+procedure TTestExpressionWriter.TestUnaryNot;
+begin
+  TestUnary('unary not expresssion',TJSUnaryNotExpression,'!a');
+end;
+
+procedure TTestExpressionWriter.TestPostPlusPLus;
+begin
+  TestUnary('postfix ++ expresssion',TJSUnaryPostPlusPlusExpression,'a++');
+end;
+
+procedure TTestExpressionWriter.TestPostMinusMinus;
+begin
+  TestUnary('postfix -- expresssion',TJSUnaryPostMinusMinusExpression,'a--');
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalOr;
+begin
+  TestBinary('logical or',TJSLogicalOrExpression,'(a || b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalOrCompact;
+begin
+  TestBinary('logical or',TJSLogicalOrExpression,'(a||b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalOrNested;
+begin
+  TestBinaryNested('logical or',TJSLogicalOrExpression,'(a||b||c||d)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalAnd;
+begin
+  TestBinary('logical or',TJSLogicalAndExpression,'(a && b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalAndCompact;
+begin
+  TestBinary('logical or',TJSLogicalAndExpression,'(a&&b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLogicalAndNested;
+begin
+  TestBinaryNested('logical and',TJSLogicalAndExpression,'(a&&b&&c&&d)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseOr;
+begin
+  TestBinary('Bitwise or',TJSBitwiseOrExpression,'(a | b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseOrCompact;
+begin
+  TestBinary('Bitwise or',TJSBitwiseOrExpression,'(a|b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseAnd;
+begin
+  TestBinary('Bitwise and',TJSBitwiseAndExpression,'(a & b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseAndCompact;
+begin
+  TestBinary('Bitwise and',TJSBitwiseAndExpression,'(a&b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseXOr;
+begin
+  TestBinary('Bitwise xor',TJSBitwiseXOrExpression,'(a ^ b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryBitwiseXOrCompact;
+begin
+  TestBinary('Bitwise xor',TJSBitwiseXOrExpression,'(a^b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryEQ;
+begin
+  TestBinary('Equal',TJSEqualityExpressionEQ,'(a == b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryEQCompact;
+begin
+  TestBinary('Equal',TJSEqualityExpressionEQ,'(a==b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryNE;
+begin
+  TestBinary('Not Equal',TJSEqualityExpressionNE,'(a != b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryNECompact;
+begin
+  TestBinary('Not Equal',TJSEqualityExpressionNE,'(a!=b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinarySEQ;
+begin
+  TestBinary('Strictly Equal',TJSEqualityExpressionSEQ,'(a === b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinarySEQCompact;
+begin
+  TestBinary('Strictly Equal',TJSEqualityExpressionSEQ,'(a===b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinarySNE;
+begin
+  TestBinary('Strictly Equal',TJSEqualityExpressionSNE,'(a !== b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinarySNECompact;
+begin
+  TestBinary('Strictly Equal',TJSEqualityExpressionSNE,'(a!==b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLT;
+begin
+  TestBinary('Less than',TJSRelationalExpressionLT,'(a < b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLTCompact;
+begin
+  TestBinary('Less than',TJSRelationalExpressionLT,'(a<b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryGT;
+begin
+  TestBinary('Greater than',TJSRelationalExpressionGT,'(a > b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryGTCompact;
+begin
+  TestBinary('Greater than',TJSRelationalExpressionGT,'(a>b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLE;
+begin
+  TestBinary('Less than or equal',TJSRelationalExpressionLE,'(a <= b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLECompact;
+begin
+  TestBinary('Less than or equal',TJSRelationalExpressionLE,'(a<=b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryGE;
+begin
+  TestBinary('Greater than or equal',TJSRelationalExpressionGE,'(a >= b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryGECompact;
+begin
+  TestBinary('Greater than or equal',TJSRelationalExpressionGE,'(a>=b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryIN;
+begin
+  TestBinary('Prop in Object',TJSRelationalExpressionIN,'(a in b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryINCompact;
+begin
+  TestBinary('Prop in Object',TJSRelationalExpressionIN,'(a in b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryInstanceOf;
+begin
+  TestBinary('A instanceof Object',TJSRelationalExpressionInStanceOf,'(a instanceof b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryInstanceOfCompact;
+begin
+  TestBinary('A instanceof Object',TJSRelationalExpressionInStanceOf,'(a instanceof b)',true);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLShift;
+begin
+  TestBinary('A lshift B',TJSLShiftExpression,'(a << b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryLShiftOfCompact;
+begin
+  TestBinary('A lshift B',TJSLShiftExpression,'(a<<b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryRShift;
+begin
+  TestBinary('A rshift B',TJSRShiftExpression,'(a >> b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryRShiftOfCompact;
+begin
+  TestBinary('A rshift B',TJSRShiftExpression,'(a>>b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryURShift;
+begin
+  TestBinary('A urshift B',TJSURShiftExpression,'(a >>> b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryURShiftOfCompact;
+begin
+  TestBinary('A urshift B',TJSURShiftExpression,'(a>>>b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryPlus;
+begin
+  TestBinary('A plus B',TJSAdditiveExpressionPlus,'(a + b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryPlusCompact;
+begin
+  TestBinary('A plus B',TJSAdditiveExpressionPlus,'(a+b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryPlusNested;
+begin
+  TestBinaryNested('(A+B)+(C+D)',TJSAdditiveExpressionPlus,'(a+b+(c+d))',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMinus;
+begin
+  TestBinary('A minus B',TJSAdditiveExpressionMinus,'(a - b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMinusCompact;
+begin
+  TestBinary('A minus B',TJSAdditiveExpressionMinus,'(a-b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMinusNested;
+begin
+  TestBinaryNested('(A-B)-(C-D)',TJSAdditiveExpressionMinus,'(a-b-(c-d))',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMultiply;
+begin
+  TestBinary('A multiply B',TJSMultiplicativeExpressionMul,'(a * b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMultiplyCompact;
+begin
+  TestBinary('A multiply B',TJSMultiplicativeExpressionMul,'(a*b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMultiplyNested;
+begin
+  TestBinaryNested('(A*B)*(C*D)',TJSMultiplicativeExpressionMul,'(a*b*(c*d))',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryDivide;
+begin
+  TestBinary('A divide B',TJSMultiplicativeExpressionDiv,'(a / b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryDivideCompact;
+begin
+  TestBinary('A divide B',TJSMultiplicativeExpressionDiv,'(a/b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryMod;
+begin
+  TestBinary('A mod B',TJSMultiplicativeExpressionMod,'(a % b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryModCompact;
+begin
+  TestBinary('A mod B',TJSMultiplicativeExpressionMod,'(a%b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryComma;
+begin
+  TestBinary('A comma B',TJSCommaExpression,'(a, b)',False);
+end;
+
+procedure TTestExpressionWriter.TestBinaryCommaCompact;
+begin
+  TestBinary('A comma B',TJSCommaExpression,'(a,b)',True);
+end;
+
+procedure TTestExpressionWriter.TestBinaryCallDiv;
+var
+  aDiv: TJSMultiplicativeExpressionDiv;
+  LeftMul: TJSMultiplicativeExpressionMul;
+  LeftCall: TJSCallExpression;
+  RightSub: TJSAdditiveExpressionMinus;
+  Expr: String;
+begin
+  // (2*f(3))/(a-4)
+  aDiv:=TJSMultiplicativeExpressionDiv.Create(0,0);
+  // (2*f(3))
+  LeftMul:=TJSMultiplicativeExpressionMul.Create(0,0);
+  aDiv.A:=LeftMul;
+  // 2
+  LeftMul.A:=CreateLiteral(2);
+  // f(3)
+  LeftCall:=TJSCallExpression.Create(0,0);
+  LeftMul.B:=LeftCall;
+  LeftCall.Expr:=CreateIdent('f');
+  LeftCall.Args:=TJSArguments.Create(0,0);
+  LeftCall.AddArg(CreateLiteral(3));
+  // (a-4)
+  RightSub:=TJSAdditiveExpressionMinus.Create(0,0);
+  aDiv.B:=RightSub;
+  RightSub.A:=CreateIdent('a');
+  RightSub.B:=CreateLiteral(4);
+
+  Expr:='((2 * f(3)) / (a - 4))';
+  AssertWrite('keep needed brackets of '+Expr,Expr,aDiv);
+end;
+
+procedure TTestExpressionWriter.TestDotMember;
+Var
+  U : TJSDotMemberExpression;
+
+begin
+  U:=TJSDotMemberExpression.Create(0,0);
+  U.Mexpr:=CreateIdent('a');
+  U.Name:='b';
+  AssertWrite('member b of object a (a.b)','a.b',U);
+end;
+
+procedure TTestExpressionWriter.TestArgMember;
+Var
+  U : TJSBracketMemberExpression;
+
+begin
+  U:=TJSBracketMemberExpression.Create(0,0);
+  U.Mexpr:=CreateIdent('a');
+  U.Name:=CreateIdent('b');
+  AssertWrite('member b of object a (a[b])','a[b]',U);
+end;
+
+procedure TTestExpressionWriter.TestNewMember;
+Var
+  U : TJSNewMemberExpression;
+
+begin
+  U:=TJSNewMemberExpression.Create(0,0);
+  U.Mexpr:=CreateIdent('a');;
+  U.Args:=TJSArguments.Create(0,0);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[0].Expr:=CreateLiteral(123);
+  AssertWrite('member b of object a (a[b])','new a(123)',U);
+end;
+
+procedure TTestExpressionWriter.TestNewMemberCompact;
+
+Var
+  U : TJSNewMemberExpression;
+
+begin
+  Writer.Options:=Writer.Options+[woCompact];
+  U:=TJSNewMemberExpression.Create(0,0);
+  U.Mexpr:=CreateIdent('a');
+  U.Args:=TJSArguments.Create(0,0);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[0].Expr:=CreateLiteral(123);
+  AssertWrite('new a(123)','new a(123)',U);
+end;
+
+procedure TTestExpressionWriter.TestNewMemberNoArgs;
+Var
+  U : TJSNewMemberExpression;
+
+begin
+  U:=TJSNewMemberExpression.Create(0,0);
+  U.Mexpr:=CreateIdent('a');
+  AssertWrite('new a()','new a()',U);
+end;
+
+procedure TTestExpressionWriter.TestCall;
+Var
+  U : TJSCallExpression;
+
+begin
+  U:=TJSCallExpression.Create(0,0);
+  U.Expr:=CreateIdent('a');
+  U.Args:=TJSArguments.Create(0,0);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[0].Expr:=CreateLiteral(123);
+  AssertWrite('call a(123)',
+     'a(123)',U);
+end;
+
+procedure TTestExpressionWriter.TestCallCompact;
+Var
+  U : TJSCallExpression;
+
+begin
+  Writer.Options:=Writer.Options+[woCompact];
+  U:=TJSCallExpression.Create(0,0);
+  U.Expr:=CreateIdent('a');
+  U.Args:=TJSArguments.Create(0,0);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[0].Expr:=CreateLiteral(123);
+  AssertWrite('call a(123)','a(123)',U);
+end;
+
+procedure TTestExpressionWriter.TestCallCompact2;
+Var
+  U : TJSCallExpression;
+
+begin
+  Writer.Options:=Writer.Options+[woCompactArguments];
+  U:=TJSCallExpression.Create(0,0);
+  U.Expr:=CreateIdent('a');
+  U.Args:=TJSArguments.Create(0,0);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[0].Expr:=CreateLiteral(123);
+  U.Args.Elements.AddElement;
+  U.Args.Elements[1].Expr:=CreateLiteral(456);
+  AssertWrite('call a(123,456)','a(123,456)',U);
+
+end;
+
+procedure TTestExpressionWriter.TestCallNoArgs;
+Var
+  U : TJSCallExpression;
+
+begin
+  U:=TJSCallExpression.Create(0,0);
+  U.Expr:=CreateIdent('a');
+  AssertWrite('call a()','a()',U);
+end;
+
+procedure TTestExpressionWriter.TestConditional;
+Var
+  U : TJSConditionalExpression;
+
+begin
+  U:=TJSConditionalExpression.Create(0,0);
+  U.A:=CreateIdent('a');
+  U.B:=CreateIdent('b');
+  U.C:=CreateIdent('c');
+  AssertWrite('a ? b : c','(a ? b : c)',U);
+end;
+
+procedure TTestExpressionWriter.TestRegularExpressionLiteral;
+
+Var
+  S : TJSRegularExpressionLiteral;
+begin
+  S:=TJSRegularExpressionLiteral.Create(0,0);
+  S.Pattern.AsString:='a';
+  AssertWrite('/a/','/a/',S);
+end;
+
+procedure TTestExpressionWriter.TestRegularExpressionLiteralFlags;
+Var
+  S : TJSRegularExpressionLiteral;
+begin
+  S:=TJSRegularExpressionLiteral.Create(0,0);
+  S.Pattern.AsString:='a';
+  S.PatternFlags.AsString:='g';
+  AssertWrite('/a/g','/a/g',S);
+end;
+
+{ ---------------------------------------------------------------------
+  TTestStatementWriter
+  ---------------------------------------------------------------------}
+
+procedure TTestStatementWriter.TestAssignment(const Msg: String;
+  AClass: TJSAssignStatementClass; Result: String; ACompact: Boolean);
+Var
+  U : TJSAssignStatement;
+begin
+  if ACompact then
+    Writer.Options:=Writer.Options+[woCompact];
+  U:=CreateAssignment(AClass);
+  AssertWrite(Msg,Result,U);
+end;
+
+function TTestStatementWriter.CreateAssignment(AClass: TJSAssignStatementClass
+  ): TJSAssignStatement;
+begin
+  if AClass=Nil then
+     AClass := TJSSimpleAssignStatement;
+  Result:=AClass.Create(0,0);
+  Result.LHS:=CreateIdent('a');
+  Result.Expr:=CreateIdent('b');
+end;
+
+function TTestStatementWriter.CreateStatementListOneElement: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+end;
+
+function TTestStatementWriter.CreateStatementListTwoElement2: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+  Result.B:=CreateAssignment(nil);
+end;
+
+procedure TTestStatementWriter.TestEmptyStatement;
+
+begin
+  AssertWrite('Empty statement','',TJSEmptyStatement.Create(0,0));
+end;
+
+procedure TTestStatementWriter.TestEmptyStatementComment;
+begin
+  Writer.Options:=[woEmptyStatementAsComment,woUseUTF8];
+  AssertWrite('Empty statement as comment','/* Empty statement */',TJSEmptyStatement.Create(0,0));
+end;
+
+procedure TTestStatementWriter.TestEmptyStatementBlock;
+begin
+  AssertWrite('Empty statement block','{'+sLineBreak+'}',TJSEmptyBlockStatement.Create(0,0));
+end;
+
+procedure TTestStatementWriter.TestEmptyStatementBlockIndent;
+begin
+  Writer.IndentSize:=2;
+  Writer.Indent;
+  AssertWrite('Empty statement block','  {'+sLineBreak+'  }',TJSEmptyBlockStatement.Create(0,0));
+end;
+
+procedure TTestStatementWriter.TestEmptyStatementBlockCompact;
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  AssertWrite('Empty statement block','{}',TJSEmptyBlockStatement.Create(0,0));
+end;
+
+procedure TTestStatementWriter.TestVarDeclaration;
+
+Var
+  V : TJSVarDeclaration;
+begin
+  V:=TJSVarDeclaration.Create(0,0);
+  V.Name:='a';
+  AssertWrite('simple var','a',V);
+end;
+
+procedure TTestStatementWriter.TestVarDeclarationInit;
+Var
+  V : TJSVarDeclaration;
+begin
+  V:=TJSVarDeclaration.Create(0,0);
+  V.Name:='a';
+  V.Init:=CreateLiteral(1);
+  AssertWrite('simple var, init ','a = 1',V);
+end;
+
+procedure TTestStatementWriter.TestVarListDeclaration;
+Var
+  B,L : TJSVariableDeclarationList;
+  V : TJSVarDeclaration;
+
+begin
+  L:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);
+  V.Name:='a';
+  L.A:=V;
+  B:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);
+  V.Name:='b';
+  B.A:=V;
+  V.Init:=CreateLiteral(1);
+  L.B:=B;
+  AssertWrite('simple var list ','a, b = 1',L);
+end;
+
+procedure TTestStatementWriter.TestVarListDeclarationInit;
+Var
+  B,L : TJSVariableDeclarationList;
+  V : TJSVarDeclaration;
+
+
+begin
+  L:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);;
+  V.Name:='a';
+  L.A:=V;
+  B:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);;
+  V.Name:='b';
+  B.A:=V;
+  L.B:=B;
+  AssertWrite('simple var list ','a, b',L);
+end;
+
+procedure TTestStatementWriter.TestVarDeclarationStatement;
+
+Var
+  S : TJSVariableStatement;
+  V : TJSVarDeclaration;
+begin
+  S:=TJSVariableStatement.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);
+  S.A:=V;
+  V.Name:='a';
+  AssertWrite('simple var','var a',S);
+end;
+
+procedure TTestStatementWriter.TestVarListDeclarationStatement;
+
+Var
+  S : TJSVariableStatement;
+  V : TJSVarDeclaration;
+  L : TJSVariableDeclarationList;
+
+begin
+  S:=TJSVariableStatement.Create(0,0);
+  L:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);
+  L.A:=V;
+  S.A:=L;
+  V.Name:='a';
+  AssertWrite('simple var','var a',S);
+end;
+
+procedure TTestStatementWriter.TestVarListDeclarationStatement2Vars;
+Var
+  S : TJSVariableStatement;
+  V : TJSVarDeclaration;
+  L : TJSVariableDeclarationList;
+
+begin
+  S:=TJSVariableStatement.Create(0,0);
+  L:=TJSVariableDeclarationList.Create(0,0);
+  S.A:=L;
+  V:=TJSVarDeclaration.Create(0,0);
+  L.A:=V;
+  V.Name:='a';
+  L.B:=TJSVariableDeclarationList.Create(0,0);
+  L:=TJSVariableDeclarationList(L.B);
+  V:=TJSVarDeclaration.Create(0,0);
+  L.A:=V;
+  V.Name:='b';
+  AssertWrite('simple 2 vars','var a, b',S);
+end;
+
+procedure TTestStatementWriter.TestVarListDeclarationStatement3Vars;
+Var
+  S : TJSVariableStatement;
+  V : TJSVarDeclaration;
+  L : TJSVariableDeclarationList;
+
+begin
+  S:=TJSVariableStatement.Create(0,0);
+  L:=TJSVariableDeclarationList.Create(0,0);
+  S.A:=L;
+  V:=TJSVarDeclaration.Create(0,0);
+  L.A:=V;
+  V.Name:='a';
+  V.Init:=CreateLiteral(1);
+  L.B:=TJSVariableDeclarationList.Create(0,0);
+  L:=TJSVariableDeclarationList(L.B);
+  V:=TJSVarDeclaration.Create(0,0);
+  L.A:=V;
+  V.Name:='b';
+  V.Init:=CreateLiteral(2);
+  V:=TJSVarDeclaration.Create(0,0);
+  L.B:=V;
+  V.Name:='c';
+  V.Init:=CreateLiteral(3);
+  AssertWrite('simple 3 vars','var a = 1, b = 2, c = 3',S);
+end;
+
+procedure TTestStatementWriter.TestReturnStatement;
+Var
+  S : TJSReturnStatement;
+
+begin
+  S:=TJSReturnStatement.Create(0,0);
+  S.Expr:=CreateIdent('a');
+  AssertWrite('simple return','return a',S);
+end;
+
+procedure TTestStatementWriter.TestLabeledStatement;
+Var
+  LS : TJSLabeledStatement;
+  S : TJSReturnStatement;
+
+begin
+  LS:=TJSLabeledStatement.Create(0,0);
+  LS.TheLabel:=TJSLabel.Create;
+  LS.TheLabel.Name:='loc';
+  S:=TJSReturnStatement.Create(0,0);
+  S.Expr:=CreateIDent('a');
+  LS.A:=S;
+  AssertWrite('simple return','loc:'+sLineBreak+'return a',LS);
+end;
+
+procedure TTestStatementWriter.TestLabeledStatementCompact;
+Var
+  LS : TJSLabeledStatement;
+  S : TJSReturnStatement;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  LS:=TJSLabeledStatement.Create(0,0);
+  LS.TheLabel:=TJSLabel.Create;
+  LS.TheLabel.Name:='loc';
+  S:=TJSReturnStatement.Create(0,0);
+  S.Expr:=CreateIdent('a');
+  LS.A:=S;
+  AssertWrite('simple return','loc: return a',LS);
+end;
+
+procedure TTestStatementWriter.TestContinueStatement;
+
+Var
+  S : TJSContinueStatement;
+
+begin
+  S:=TJSContinueStatement.Create(0,0);
+  AssertWrite('simple continue','continue',S);
+end;
+
+procedure TTestStatementWriter.TestContinueTargetStatement;
+
+Var
+  S : TJSContinueStatement;
+
+begin
+  S:=TJSContinueStatement.Create(0,0);
+  S.TargetName:='a';
+  AssertWrite('continue a','continue a',S);
+end;
+
+procedure TTestStatementWriter.TestBreakStatement;
+
+Var
+  S : TJSBreakStatement;
+
+begin
+  S:=TJSBreakStatement.Create(0,0);
+  AssertWrite('simple break','break',S);
+end;
+
+procedure TTestStatementWriter.TestBreakTargetStatement;
+Var
+  S : TJSBreakStatement;
+
+begin
+  S:=TJSBreakStatement.Create(0,0);
+  S.TargetName:='a';
+  AssertWrite('simple break a','break a',S);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementSimple;
+begin
+  TestAssignment('Simple assignment',TJSSimpleAssignStatement,'a = b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementSimpleCompact;
+begin
+  TestAssignment('Simple assignment',TJSSimpleAssignStatement,'a=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementAdd;
+begin
+  TestAssignment('Add assignment',TJSAddEqAssignStatement,'a += b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementAddCompact;
+begin
+  TestAssignment('Add assignment',TJSAddEqAssignStatement,'a+=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementSubtract;
+begin
+  TestAssignment('Subtract assignment',TJSSubEqAssignStatement,'a -= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementSubtractCompact;
+begin
+  TestAssignment('Subtract assignment',TJSSubEqAssignStatement,'a-=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementMultiply;
+begin
+  TestAssignment('Multiply assignment',TJSMulEqAssignStatement,'a *= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementMultiplyCompact;
+begin
+  TestAssignment('Multiply assignment',TJSMulEqAssignStatement,'a*=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementDivide;
+begin
+  TestAssignment('Divide assignment',TJSDivEqAssignStatement,'a /= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementDivideCompact;
+begin
+  TestAssignment('Divide assignment',TJSDivEqAssignStatement,'a/=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementShift;
+begin
+  TestAssignment('Shift assignment',TJSLShiftEqAssignStatement,'a <<= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementShiftCompact;
+begin
+  TestAssignment('Shift assignment',TJSLShiftEqAssignStatement,'a<<=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementRShift;
+begin
+  TestAssignment('RShift assignment',TJSRShiftEqAssignStatement,'a >>= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementRShiftCompact;
+begin
+  TestAssignment('RShift assignment',TJSRShiftEqAssignStatement,'a>>=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementURShift;
+begin
+  TestAssignment('URShift assignment',TJSURShiftEqAssignStatement,'a >>>= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementURShiftCompact;
+begin
+  TestAssignment('URShift assignment',TJSURShiftEqAssignStatement,'a>>>=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementMod;
+begin
+  TestAssignment('Mod assignment',TJSModEqAssignStatement,'a %= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementModCompact;
+begin
+  TestAssignment('Mod assignment',TJSModEqAssignStatement,'a%=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryOr;
+begin
+  TestAssignment('Binary or assignment',TJSOrEqAssignStatement,'a |= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryOrCompact;
+begin
+  TestAssignment('Binary or assignment',TJSOrEqAssignStatement,'a |= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryXOr;
+begin
+  TestAssignment('Binary xor assignment',TJSXOrEqAssignStatement,'a ^= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryXOrCompact;
+begin
+  TestAssignment('Binary xor assignment',TJSXOrEqAssignStatement,'a^=b',True);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryAnd;
+begin
+  TestAssignment('Binary and assignment',TJSAndEqAssignStatement,'a &= b',False);
+end;
+
+procedure TTestStatementWriter.TestAssignmentStatementBinaryAndCompact;
+begin
+  TestAssignment('Binary and assignment',TJSAndEqAssignStatement,'a&=b',True);
+end;
+
+procedure TTestStatementWriter.TestForStatementEmpty;
+
+Var
+  S : TJSForStatement;
+begin
+  S:=TJSForStatement.Create(0,0);
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('neverending for','for (; ; ) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatementFull;
+
+Var
+  S : TJSForStatement;
+  UPP : TJSUnaryPostPlusPlusExpression;
+  CL : TJSRelationalExpressionLT;
+  sa : TJSSimpleAssignStatement;
+
+begin
+  SA:=TJSSimpleAssignStatement.Create(0,0);
+  SA.LHS:=CreateIdent('i');
+  SA.Expr:=CreateLiteral(0);
+  UPP:=TJSUnaryPostPlusPlusExpression.Create(0,0);
+  UPP.A:=CreateIdent('i');
+  CL:=TJSRelationalExpressionLT.Create(0,0);
+  CL.A:=CreateIdent('i');
+  CL.B:=CreateLiteral(10);
+  S:=TJSForStatement.Create(0,0);
+  S.Init:=SA;
+  S.Incr:=UPP;
+  S.Cond:=CL;
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('for i:=0 to 9','for (i = 0; i < 10; i++) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatementFull1;
+
+Var
+  S : TJSForStatement;
+  UPP : TJSUnaryPostPlusPlusExpression;
+  CL : TJSRelationalExpressionLT;
+  sa : TJSSimpleAssignStatement;
+
+begin
+  SA:=TJSSimpleAssignStatement.Create(0,0);
+  SA.LHS:=CreateIdent('i');
+  SA.Expr:=CreateLiteral(0);
+  UPP:=TJSUnaryPostPlusPlusExpression.Create(0,0);
+  UPP.A:=CreateIdent('i');
+  CL:=TJSRelationalExpressionLT.Create(0,0);
+  CL.A:=CreateIdent('i');
+  CL.B:=CreateLiteral(10);
+  S:=TJSForStatement.Create(0,0);
+  S.Init:=SA;
+  S.Incr:=UPP;
+  S.Cond:=CL;
+  S.Body:=CreateStatementListOneElement;
+  AssertWrite('for i:=0 to 9',
+     'for (i = 0; i < 10; i++) {'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatementCompact;
+Var
+  S : TJSForStatement;
+  UPP : TJSUnaryPostPlusPlusExpression;
+  CL : TJSRelationalExpressionLT;
+  sa : TJSSimpleAssignStatement;
+
+begin
+  SA:=TJSSimpleAssignStatement.Create(0,0);
+  SA.LHS:=CreateIdent('i');
+  SA.Expr:=CreateLiteral(0);
+  UPP:=TJSUnaryPostPlusPlusExpression.Create(0,0);
+  UPP.A:=CreateIdent('i');
+  CL:=TJSRelationalExpressionLT.Create(0,0);
+  CL.A:=CreateIdent('i');
+  CL.B:=CreateLiteral(10);
+  S:=TJSForStatement.Create(0,0);
+  S.Init:=SA;
+  S.Incr:=UPP;
+  S.Cond:=CL;
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  Writer.Options:=[woCompact,woUseUTF8];
+  AssertWrite('for i:=0 to 9','for (i=0; i<10; i++) {}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatement2loops2inits;
+var
+  L: TJSStatementList;
+
+  function CreateIdent(aName: string): TJSPrimaryExpressionIdent;
+  begin
+    Result:=TJSPrimaryExpressionIdent.Create(0,0);
+    Result.Name:=TJSString(aName);
+  end;
+
+  function CreateNumber(i: TJSNumber): TJSLiteral;
+  begin
+    Result:=TJSLiteral.Create(0,0);
+    Result.Value.AsNumber:=i;
+  end;
+
+  function CreateAssignSt(LHS, Expr: TJSElement): TJSSimpleAssignStatement;
+  begin
+    Result:=TJSSimpleAssignStatement.Create(0,0);
+    Result.LHS:=LHS;
+    Result.Expr:=Expr;
+  end;
+
+  function CreateFor(LoopVar, LoopEndVar: string; StartExpr, EndExpr: TJSElement;
+    Up: boolean; Target: string): TJSForStatement;
+  var
+    V: TJSVariableStatement;
+    C: TJSCommaExpression;
+  begin
+    Result:=TJSForStatement.Create(0,0);
+    V:=TJSVariableStatement.Create(0,0);
+    Result.Init:=V;
+    C:=TJSCommaExpression.Create(0,0);
+    V.A:=C;
+    C.A:=CreateAssignSt(CreateIdent(LoopVar),StartExpr);
+    C.B:=CreateAssignSt(CreateIdent(LoopEndVar),EndExpr);
+
+    if Up then
+      Result.Cond:=TJSRelationalExpressionLE.Create(0,0)
+    else
+      Result.Cond:=TJSRelationalExpressionGE.Create(0,0);
+    TJSRelationalExpression(Result.Cond).A:=CreateIdent(LoopVar);
+    TJSRelationalExpression(Result.Cond).B:=CreateIdent(LoopEndVar);
+
+    if Up then
+      Result.Incr:=TJSUnaryPostPlusPlusExpression.Create(0,0)
+    else
+      Result.Incr:=TJSUnaryPostMinusMinusExpression.Create(0,0);
+    TJSUnaryExpression(Result.Incr).A:=CreateIdent(LoopVar);
+
+    Result.Body:=CreateAssignSt(CreateIdent(Target),CreateIdent(LoopVar));
+  end;
+
+begin
+  L:=TJSStatementList.Create(0,0);
+  L.A:=CreateFor('$loop1','$loopend2',CreateNumber(3),CreateNumber(5),true,'$mod.i');
+  L.B:=CreateFor('$loop3','$loopend4',CreateNumber(10),CreateNumber(7),false,'$mod.i');
+  AssertWrite('for i:=3 to 5 do ; for i:=10 downto 7 do ;',
+    '{'+LineEnding
+    +'for (var $loop1 = 3, $loopend2 = 5; $loop1 <= $loopend2; $loop1++) $mod.i = $loop1;'+LineEnding
+    +'for (var $loop3 = 10, $loopend4 = 7; $loop3 >= $loopend4; $loop3--) $mod.i = $loop3;'+LineEnding
+    +'}'
+    ,L);
+end;
+
+procedure TTestStatementWriter.TestForInStatement;
+
+Var
+  S : TJSForInStatement;
+
+begin
+  S:=TJSForInStatement.Create(0,0);
+  S.LHS:=CreateIdent('a');
+  S.List:=CreateIdent('b');
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('for a in b','for (a in b) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestWhileStatement;
+Var
+  S : TJSWhileStatement;
+
+begin
+  S:=TJSWhileStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('while a ','while (a) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestDoWhileStatement;
+
+Var
+  S : TJSDoWhileStatement;
+
+begin
+  S:=TJSDoWhileStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  S.Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('do while a ','do {'+sLineBreak+'} while (a)',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementEmpty;
+Var
+  S : TJSSwitchStatement;
+
+begin
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  AssertWrite('switch ','switch (a) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementEmptyCompact;
+
+Var
+  S : TJSSwitchStatement;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  AssertWrite('switch ','switch (a) {}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementOneElement;
+
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  AssertWrite('switch ','switch (a) {'+sLineBreak+'case c:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementOneElementCompact;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  AssertWrite('switch ','switch (a) {case c: {}}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElements;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  AssertWrite('switch ','switch (a) {'+sLineBreak+'case c:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'case d:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElementsCompact;
+
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  AssertWrite('switch ','switch (a) {case c: {} case d: {}}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElementsDefault;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  S.TheDefault:=C;
+  AssertWrite('switch ','switch (a) {'+sLineBreak+'case c:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'case d:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'default:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElementsDefaultCompact;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  S.TheDefault:=C;
+  AssertWrite('switch ','switch (a) {case c: {} case d: {} default: {}}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmpty;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  S.TheDefault:=C;
+  AssertWrite('switch ',
+     'switch (a) {'+sLineBreak
+    +'case c:'+sLineBreak
+    +'case d:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'default:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmptyCompact;
+Var
+  S : TJSSwitchStatement;
+  C : TJSCaseElement;
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSSwitchStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  C:=S.Cases.AddCase;
+  C.Expr:=CreateIdent('c');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  C.Expr:=CreateIdent('d');
+  C:=S.Cases.AddCase;
+  C.Body:=TJSEmptyBlockStatement.Create(0,0);;
+  S.TheDefault:=C;
+  AssertWrite('switch ','switch (a) {case c: case d: {} default: {}}',S);
+end;
+
+procedure TTestStatementWriter.TestIfThen;
+Var
+  S : TJSIfStatement;
+
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSIfStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  S.btrue:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('if then','if (a) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestIfThenElse;
+Var
+  S : TJSIfStatement;
+
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSIfStatement.Create(0,0);
+  S.Cond:=CreateIdent('a');
+  S.btrue:=TJSEmptyBlockStatement.Create(0,0);
+  S.bfalse:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('if then',
+     'if (a) {'+sLineBreak
+    +'} else {'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListEmpty;
+Var
+  S : TJSStatementList;
+
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  AssertWrite('Statement list','{'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListEmptyCompact;
+Var
+  S : TJSStatementList;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  AssertWrite('Statement list','{}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListOneStatement;
+Var
+  S : TJSStatementList;
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=CreateAssignment(nil);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListOneStatementCompact;
+
+Var
+  S : TJSStatementList;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=CreateAssignment(nil);
+  AssertWrite('Statement list','{a=b}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListTwoStatements;
+Var
+  S : TJSStatementList;
+
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=CreateAssignment(nil);
+  S.B:=CreateAssignment(nil);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListTwoStatementsCompact;
+Var
+  S : TJSStatementList;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=CreateAssignment(nil);
+  S.B:=CreateAssignment(nil);
+  AssertWrite('Statement list','{a=b; a=b}',S);
+end;
+
+procedure TTestStatementWriter.TestStatementListFor;
+Var
+  S : TJSStatementList;
+begin
+  // Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=TJSForStatement.Create(0,0);
+  TJSForStatement(S.A).Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'for (; ; ) {'+sLineBreak
+    +'};'+sLineBreak
+    +'}',S);
+end;
+
+procedure TTestStatementWriter.TestEmptyFunctionDef;
+
+Var
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  AssertWrite('Empty function',
+     'function a() {'+sLineBreak
+    +'}',FD);
+end;
+
+procedure TTestStatementWriter.TestEmptyFunctionDefCompact;
+
+Var
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  AssertWrite('Empty function, compact','function a() {}',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefParams;
+Var
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+//  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Params.Add('b');
+  FD.AFunction.Params.Add('c');
+  FD.AFunction.Params.Add('d');
+
+  AssertWrite('Empty function, 3 params',
+     'function a(b, c, d) {'+sLineBreak
+    +'}',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefParamsCompact;
+
+Var
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Params.Add('b');
+  FD.AFunction.Params.Add('c');
+  FD.AFunction.Params.Add('d');
+  AssertWrite('Empty function, 3 params, compact','function a(b,c,d) {}',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefBody1;
+
+Var
+  FD : TJSFunctionDeclarationStatement;
+  R : TJSReturnStatement;
+
+begin
+  Writer.IndentSize:=2;
+  // Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Body:=TJSFunctionBody.Create(0,0);
+  R:=TJSReturnStatement.Create(0,0);
+  R.Expr:=CreateLiteral(0);
+  FD.AFunction.Body.A:=R;
+  AssertWrite('1 statement, ',
+     'function a() {'+sLineBreak
+    +'  return 0;'+sLineBreak
+    +'}',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefBody1Compact;
+Var
+  FD : TJSFunctionDeclarationStatement;
+  R : TJSReturnStatement;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Body:=TJSFunctionBody.Create(0,0);
+  R:=TJSReturnStatement.Create(0,0);
+  R.Expr:=CreateLiteral(0);
+  FD.AFunction.Body.A:=R;
+  AssertWrite('1 statement, compact','function a() {return 0; }',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefBody2;
+Var
+  FD : TJSFunctionDeclarationStatement;
+  R : TJSReturnStatement;
+  L : TJSStatementList;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+//  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Body:=TJSFunctionBody.Create(0,0);
+  FD.AFunction.Params.Add('b');
+  R:=TJSReturnStatement.Create(0,0);
+  R.Expr:=CreateIdent('b');
+  L:=TJSStatementList.Create(0,0);
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  L.A:=A;
+  L.B:=R;
+  FD.AFunction.Body.A:=L;
+  AssertWrite('Function, 2 statements',
+     'function a(b) {'+sLineBreak
+    +'  b = b * 10;'+sLineBreak
+    +'  return b;'+sLineBreak
+    +'}',FD);
+end;
+
+procedure TTestStatementWriter.TestFunctionDefBody2Compact;
+Var
+  FD : TJSFunctionDeclarationStatement;
+  R : TJSReturnStatement;
+  L : TJSStatementList;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.Name:='a';
+  FD.AFunction.Body:=TJSFunctionBody.Create(0,0);
+  FD.AFunction.Params.Add('b');
+  R:=TJSReturnStatement.Create(0,0);
+  R.Expr:=CreateIdent('b');
+  L:=TJSStatementList.Create(0,0);
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  L.A:=A;
+  L.B:=R;
+  FD.AFunction.Body.A:=L;
+  AssertWrite('Function, 2 statements, compact','function a(b) {b=b*10; return b}',FD);
+end;
+
+procedure TTestStatementWriter.TestTryCatch;
+
+Var
+  T : TJSTryCatchStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  T:=TJSTryCatchStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BCatch:=A;
+  AssertWrite('Try catch',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 1'+sLineBreak
+    +'}',T);
+end;
+
+procedure TTestStatementWriter.TestTryCatchCompact;
+Var
+  T : TJSTryCatchStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSTryCatchStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BCatch:=A;
+  AssertWrite('Try catch compact','try {b=b*10} catch (e) {b=1}',T);
+end;
+
+procedure TTestStatementWriter.TestTryFinally;
+
+Var
+  T : TJSTryFinallyStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  T:=TJSTryFinallyStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BFinally:=A;
+  AssertWrite('Try finally ',
+    'try {'+sLineBreak
+   +'  b = b * 10'+sLineBreak
+   +'} finally {'+sLineBreak
+   +'  b = 1'+sLineBreak
+   +'}',T);
+end;
+
+procedure TTestStatementWriter.TestTryFinallyCompact;
+
+Var
+  T : TJSTryFinallyStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSTryFinallyStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BFinally:=A;
+  AssertWrite('Try finally compact','try {b=b*10} finally {b=1}',T);
+end;
+
+procedure TTestStatementWriter.TestTryCatchFinally;
+Var
+  T : TJSTryCatchFinallyStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  T:=TJSTryCatchFinallyStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(10);
+  T.BCatch:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BFinally:=A;
+  AssertWrite('Try finally ',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 10'+sLineBreak
+    +'} finally {'+sLineBreak
+    +'  b = 1'+sLineBreak+'}',T);
+end;
+
+procedure TTestStatementWriter.TestTryCatchFinallyCompact;
+Var
+  T : TJSTryCatchFinallyStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSTryCatchFinallyStatement.Create(0,0);
+  T.Ident:='e';
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Block:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(10);
+  T.BCatch:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  A.Expr:=CreateLiteral(1);
+  T.BFinally:=A;
+  AssertWrite('Try finally ','try {b=b*10} catch (e) {b=10} finally {b=1}',T);
+end;
+
+procedure TTestStatementWriter.TestWith;
+Var
+  T : TJSWithStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+//  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSWithStatement.Create(0,0);
+  T.A:=CreateIdent('e');
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.B:=A;
+  AssertWrite('With statement ','with (e)'+slineBreak+'  b = b * 10',T);
+end;
+
+procedure TTestStatementWriter.TestWithCompact;
+Var
+  T : TJSWithStatement;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSWithStatement.Create(0,0);
+  T.A:=CreateIdent('e');
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.B:=A;
+  AssertWrite('With statement ','with (e) b=b*10',T);
+end;
+
+procedure TTestStatementWriter.TestSourceElements;
+Var
+  T : TJSSourceElements;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  //  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSSourceElements.Create(0,0);
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Statements.AddNode.Node:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('c');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('c');
+  M.B:=CreateLiteral(2);
+  A.Expr:=M;
+  T.Statements.AddNode.Node:=A;
+  AssertWrite('Statement lists ','b = b * 10;'+sLineBreak+'c = c * 2;'+sLineBreak,T);
+end;
+
+procedure TTestStatementWriter.TestSourceElementsCompact;
+Var
+  T : TJSSourceElements;
+  A : TJSAssignStatement;
+  M : TJSMultiplicativeExpressionMul;
+
+begin
+  Writer.IndentSize:=2;
+  Writer.Options:=[woCompact,woUseUTF8];
+  T:=TJSSourceElements.Create(0,0);
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('b');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('b');
+  M.B:=CreateLiteral(10);
+  A.Expr:=M;
+  T.Statements.AddNode.Node:=A;
+  A:=TJSSimpleAssignStatement.Create(0,0);
+  A.LHS:=CreateIdent('c');
+  M:=TJSMultiplicativeExpressionMul.Create(0,0);
+  M.A:=CreateIdent('c');
+  M.B:=CreateLiteral(2);
+  A.Expr:=M;
+  T.Statements.AddNode.Node:=A;
+  AssertWrite('Statement lists compact','b=b*10; c=c*2;',T);
+end;
+
+{ ---------------------------------------------------------------------
+  TTestLiteralWriter
+  ---------------------------------------------------------------------}
+
+Procedure TTestLiteralWriter.TestInteger;
+
+begin
+  AssertWrite('1','1',CreateLiteral(1));
+end;
+
+Procedure TTestLiteralWriter.TestBooleanTrue;
+
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.Asboolean:=True;
+  AssertWrite('true','true',L);
+end;
+
+Procedure TTestLiteralWriter.TestBooleanFalse;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.Asboolean:=False;
+  AssertWrite('false','false',L);
+end;
+
+Procedure TTestLiteralWriter.TestUndefined;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  AssertWrite('undefined','undefined',L);
+end;
+
+Procedure TTestLiteralWriter.TestNull;
+
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.IsNull:=True;
+  AssertWrite('null','null',L);
+end;
+
+Procedure TTestLiteralWriter.TestString;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='abcd';
+  AssertWrite('abcd','"abcd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringQuote;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab"cd';
+  AssertWrite('ab"cd','''ab"cd''',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringBackslash;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab\cd';
+  AssertWrite('ab\cd','"ab\\cd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringslash;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab/cd';
+  AssertWrite('ab/cd','"ab\/cd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringsBack;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab'#8'cd';
+  AssertWrite('ab'#8'cd','"ab\bcd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringsTab;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab'#9'cd';
+  AssertWrite('ab'#9'cd','"ab\tcd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringsLineFeed;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab'#10'cd';
+  AssertWrite('ab'#10'cd','"ab\ncd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringsFormFeed;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab'#12'cd';
+  AssertWrite('ab'#12'cd','"ab\fcd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestStringsCarriageReturn;
+Var
+  L : TJSLiteral;
+begin
+  L:=TJSLiteral.Create(0,0,'');
+  L.Value.AsString:='ab'#13'cd';
+  AssertWrite('ab'#13'cd','"ab\rcd"',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayEmpty;
+
+Var
+  L : TJSArrayLiteral;
+
+begin
+  L:=TJSArrayLiteral.Create(0,0);
+  AssertWrite('Empty array ','[]',L); // Always
+end;
+
+Procedure TTestLiteralWriter.TestArrayEmptyCompact;
+Var
+  L : TJSArrayLiteral;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  L:=TJSArrayLiteral.Create(0,0);
+  AssertWrite('Empty array ','[]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayOneElement;
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayOneElementCompact;
+
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayOneElementIndent;
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  Writer.IndentSize:=2;
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayTwoElements;
+
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1, 2]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayTwoElementsCompact;
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1,2]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayTwoElementsCompact2;
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  Writer.Options:=[woCompactArrayLiterals,woUseUTF8];
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1,2]',L);
+end;
+
+Procedure TTestLiteralWriter.TestArrayThreeElementsCompact;
+Var
+  L : TJSArrayLiteral;
+  I : TJSLiteral;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  L:=TJSArrayLiteral.Create(0,0);
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  L.Elements.AddElement.Expr:=I;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  L.Elements.AddElement.Expr:=I;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=3;
+  L.Elements.AddElement.Expr:=I;
+  AssertWrite('Empty array ','[1,2,3]',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectEmpty;
+
+Var
+  L : TJSObjectLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  AssertWrite('Empty object ','{}',L); // Always
+end;
+
+Procedure TTestLiteralWriter.TestObjectEmptyCompact;
+Var
+  L : TJSObjectLiteral;
+
+begin
+  Writer.Options:=[woCompact,woUseUTF8];
+  L:=TJSObjectLiteral.Create(0,0);
+  AssertWrite('Empty object ','{}',L); // Always
+end;
+
+Procedure TTestLiteralWriter.TestObjectOneElement;
+
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  AssertWrite('Empty object ','{'+slineBreak+'abc: 1'+sLineBreak+'}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectOneElementCompact;
+
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  Writer.Options:=[woCompact,woUseUTF8];
+  AssertWrite('Empty object ','{abc: 1}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectOneElementIndent;
+
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  Writer.IndentSize:=2;
+  AssertWrite('Empty object ','{'+slineBreak+'  abc: 1'+sLineBreak+'}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectOneElementCompactQuoted;
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  Writer.Options:=[woCompact,woUseUTF8,woQuoteElementNames];
+  AssertWrite('Empty object ','{"abc": 1}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectTwoElements;
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  E.Expr:=I;
+  E.Name:='efg';
+  AssertWrite('Empty object ','{'+slineBreak+'abc: 1,'+sLineBreak+'efg: 2'+slineBreak+'}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectTwoElementCompact;
+
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  E.Expr:=I;
+  E.Name:='efg';
+  Writer.Options:=[woCompact,woUseUTF8];
+  AssertWrite('Empty object ','{abc: 1, efg: 2}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectTwoElementCompact2;
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  E.Expr:=I;
+  E.Name:='efg';
+  Writer.Options:=[woCompactObjectLiterals,woUseUTF8];
+  AssertWrite('Empty object ','{abc: 1, efg: 2}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectTwoElementCompactQuoted;
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  E.Expr:=I;
+  E.Name:='efg';
+  Writer.Options:=[woCompact,woUseUTF8,woQuoteElementNames];
+  AssertWrite('Empty object ','{"abc": 1, "efg": 2}',L);
+end;
+
+Procedure TTestLiteralWriter.TestObjectThreeElementsCompact;
+Var
+  L : TJSObjectLiteral;
+  E : TJSObjectLiteralElement;
+  I : TJSLiteral;
+
+begin
+  L:=TJSObjectLiteral.Create(0,0);
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=1;
+  E.Expr:=I;
+  E.Name:='abc';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=2;
+  E.Expr:=I;
+  E.Name:='efg';
+  E:=L.Elements.AddElement;
+  I:=TJSLiteral.Create(0,0);
+  I.Value.AsNumber:=3;
+  E.Expr:=I;
+  E.Name:='hij';
+  Writer.Options:=[woCompact,woUseUTF8];
+  AssertWrite('Empty object ','{abc: 1, efg: 2, hij: 3}',L);
+end;
+
+{ ---------------------------------------------------------------------
+  TTestJSWriter
+  ---------------------------------------------------------------------}
+
+procedure TTestJSWriter.SetUp;
+begin
+  FTextWriter:=TBufferWriter.Create(120);
+  FWriter:=TJSWriter.Create(FTextWriter);
+end;
+
+procedure TTestJSWriter.TearDown;
+begin
+  FreeAndNil(FWriter);
+  FreeAndNil(FTextWriter);
+  FreeAndNil(FElement);
+end;
+
+Procedure TTestJSWriter.WriteElement(JS: TJSElement);
+begin
+  FElement:=JS;
+  FWriter.WriteJS(JS);
+end;
+
+Procedure TTestJSWriter.AssertResult(Const Msg, Result: String);
+
+Var
+  S : AnsiString;
+  p: Integer;
+begin
+  S:=FTextWriter.AsString;
+  if S=Result then exit;
+  p:=1;
+  while (p<=length(S)) and (p<=length(Result)) and (S[p]=Result[p]) do inc(p);
+  if p>length(S) then
+    AssertEquals(Msg+' (actual too short)',Result,S)
+  else if p>length(Result) then
+    AssertEquals(Msg+' (actual too long)',Result,S)
+  else
+    AssertEquals(Msg+' (diff at '+IntToStr(p)+' "'+S[p]+'")',Result,S);
+end;
+
+Procedure TTestJSWriter.AssertResult(Const Msg: string; Result: UnicodeString);
+
+Var
+  S : UnicodeString;
+  p: Integer;
+begin
+  S:=FTextWriter.AsUnicodeString;
+  if S=Result then exit;
+  p:=1;
+  while (p<=length(S)) and (p<=length(Result)) and (S[p]=Result[p]) do inc(p);
+  if p>length(S) then
+    AssertEquals(Msg+' (actual too short)',String(Result),String(S))
+  else if p>length(Result) then
+    AssertEquals(Msg+' (actual too long)',String(Result),String(S))
+  else
+    AssertEquals(Msg+' (diff at '+IntToStr(p)+' "'+String(S[p])+'")',String(Result),String(S));
+end;
+
+Procedure TTestJSWriter.AssertWrite(Const Msg, Result: String;
+  AElement: TJSElement);
+begin
+  WriteElement(AElement);
+  AssertResult(Msg,Result);
+end;
+
+Procedure TTestJSWriter.AssertWrite(Const Msg: string; Result: UnicodeString;
+  AElement: TJSElement);
+begin
+  WriteElement(AElement);
+  AssertResult(Msg,Result);
+end;
+
+Function TTestJSWriter.CreateIdent(Const AName: String): TJSPrimaryExpressionIdent;
+begin
+  Result:=TJSPrimaryExpressionIdent.Create(0,0);
+  Result.Name:=TJSString(AName);
+end;
+
+Function TTestJSWriter.CreateLiteral(Const AValue: TJSString): TJSLiteral;
+begin
+  Result:=TJSLiteral.Create(0,0);
+  Result.Value.AsString:=Avalue;
+end;
+
+Function TTestJSWriter.CreateLiteral(Const AValue: Integer): TJSLiteral;
+begin
+  Result:=TJSLiteral.Create(0,0);
+  Result.Value.AsNumber:=Avalue;
+end;
+
+Function TTestJSWriter.CreateLiteral(Const AValue: Boolean): TJSLiteral;
+begin
+  Result:=TJSLiteral.Create(0,0);
+  Result.Value.AsBoolean:=Avalue;
+end;
+
+{ ---------------------------------------------------------------------
+  TTestTestJSWriter
+  ---------------------------------------------------------------------}
+
+procedure TTestTestJSWriter.TestEmpty;
+begin
+  AssertNotNull('Have text writer',TextWriter);
+  AssertNotNull('Have JS writer',Writer);
+  AssertNull('Have no element',Element);
+  AssertSame('Correct text writer for js writer',TextWriter,Writer.Writer);
+  AssertEquals('No indent',0,Writer.IndentSize);
+  if not (Writer.Options=[woUseUTF8]) then
+    Fail('Options are not using UTF8');
+end;
+
+
+Initialization
+  RegisterTests([TTestTestJSWriter,TTestLiteralWriter,TTestExpressionWriter,TTestStatementWriter]);
+end.
+

BIN
compiler/packages/fcl-js/tests/testjs.ico


+ 116 - 0
compiler/packages/fcl-js/tests/testjs.lpi

@@ -0,0 +1,116 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <UseAppBundle Value="False"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="13">
+      <Unit0>
+        <Filename Value="testjs.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcscanner.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../src/jsbase.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="../src/jsparser.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../src/jsscanner.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="JSScanner"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="../src/jstree.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="tcparser.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../src/jswriter.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="tctextwriter.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="tcwriter.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../src/jstoken.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="tcsrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCSrcMap"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="../src/jssrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="JSSrcMap"/>
+      </Unit12>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 26 - 0
compiler/packages/fcl-js/tests/testjs.lpr

@@ -0,0 +1,26 @@
+program testjs;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF Unix}
+  cwstring,
+  {$ENDIF}
+  Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
+  tcparser, jswriter, tcwriter, jstoken, JSSrcMap, TCSrcMap;
+
+var
+  Application: TTestRunner;
+
+{$IFDEF WINDOWS}{$R testjs.rc}{$ENDIF}
+
+{$R *.res}
+
+begin
+  DefaultFormat:=fplain;
+  DefaultRunAllTests:=True;
+  Application := TTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

+ 17 - 0
compiler/packages/fcl-js/tests/testjs.manifest

@@ -0,0 +1,17 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+ <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
+ <description>Your application description here.</description>
+ <dependency>
+  <dependentAssembly>
+   <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
+  </dependentAssembly>
+ </dependency>
+ <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+  <security>
+   <requestedPrivileges>
+    <requestedExecutionLevel level="asInvoker" uiAccess="false"/>
+   </requestedPrivileges>
+  </security>
+ </trustInfo>
+</assembly>

+ 1 - 0
compiler/packages/fcl-js/tests/testjs.rc

@@ -0,0 +1 @@
+MAINICON ICON "testjs.ico"

BIN
compiler/packages/fcl-js/units/x86_64-linux/jsbase.ppu


BIN
compiler/packages/fcl-js/units/x86_64-linux/jsminifier.ppu


+ 6 - 0
compiler/packages/fcl-js/units/x86_64-linux/jsminifier.rsj

@@ -0,0 +1,6 @@
+{"version":1,"strings":[
+{"hash":140625918,"name":"jsminifier.serrunterminatedcomment","sourcebytes":[85,110,116,101,114,109,105,110,97,116,101,100,32,99,111,109,109,101,110,116,46],"value":"Unterminated comment."},
+{"hash":239610158,"name":"jsminifier.serrunterminatedstringliteral","sourcebytes":[85,110,116,101,114,109,105,110,97,116,101,100,32,115,116,114,105,110,103,32,108,105,116,101,114,97,108,46],"value":"Unterminated string literal."},
+{"hash":242769518,"name":"jsminifier.serrunterminatedsetinregexp","sourcebytes":[85,110,116,101,114,109,105,110,97,116,101,100,32,115,101,116,32,105,110,32,82,101,103,117,108,97,114,32,69,120,112,114,101,115,115,105,111,110,32,108,105,116,101,114,97,108,46],"value":"Unterminated set in Regular Expression literal."},
+{"hash":220045198,"name":"jsminifier.serrunterminatedregexp","sourcebytes":[85,110,116,101,114,109,105,110,97,116,101,100,32,82,101,103,117,108,97,114,32,69,120,112,114,101,115,115,105,111,110,32,108,105,116,101,114,97,108,46],"value":"Unterminated Regular Expression literal."}
+]}

BIN
compiler/packages/fcl-js/units/x86_64-linux/jsparser.ppu


+ 26 - 0
compiler/packages/fcl-js/units/x86_64-linux/jsparser.rsj

@@ -0,0 +1,26 @@
+{"version":1,"strings":[
+{"hash":180545021,"name":"jsparser.serrunmatchedcurlybrace","sourcebytes":[85,110,109,97,116,99,104,101,100,32,125],"value":"Unmatched }"},
+{"hash":180544989,"name":"jsparser.serrunmatchedsquarebrace","sourcebytes":[85,110,109,97,116,99,104,101,100,32,93],"value":"Unmatched ]"},
+{"hash":180544937,"name":"jsparser.serrunmatchedbrace","sourcebytes":[85,110,109,97,116,99,104,101,100,32,41],"value":"Unmatched )"},
+{"hash":148362119,"name":"jsparser.serrunexpectedtoken","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,39,37,115,39],"value":"Unexpected token: '%s'"},
+{"hash":187172855,"name":"jsparser.serrtokenmismatch","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,39,37,115,39,44,32,101,120,112,101,99,116,101,100,58,32,39,37,115,39],"value":"Unexpected token: '%s', expected: '%s'"},
+{"hash":233310215,"name":"jsparser.serrsemicolonorinexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,39,37,115,39,44,32,101,120,112,101,99,116,101,100,32,59,32,111,114,32,39,105,110,39],"value":"Unexpected token: '%s', expected ; or 'in'"},
+{"hash":177973979,"name":"jsparser.serrsemicolonexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,39,37,115,39,44,32,101,120,112,101,99,116,101,100,32,59],"value":"Unexpected token: '%s', expected ;"},
+{"hash":86377175,"name":"jsparser.serrduplicatelabelname","sourcebytes":[68,117,112,108,105,99,97,116,101,32,108,97,98,101,108,32,110,97,109,101,58,32,39,37,115,39],"value":"Duplicate label name: '%s'"},
+{"hash":105075422,"name":"jsparser.serrlabelnotcontinuable","sourcebytes":[76,97,98,101,108,32,39,37,115,39,32,105,115,32,110,111,116,32,115,117,105,116,97,98,108,101,32,102,111,114,32,99,111,110,116,105,110,117,101,46],"value":"Label '%s' is not suitable for continue."},
+{"hash":230725630,"name":"jsparser.serrlabelnotdefinedorreachable","sourcebytes":[76,97,98,101,108,32,39,37,115,39,32,105,115,32,110,111,116,32,100,101,102,105,110,101,100,32,111,114,32,110,111,116,32,114,101,97,99,104,97,98,108,101,46],"value":"Label '%s' is not defined or not reachable."},
+{"hash":32991728,"name":"jsparser.serrcontinuenotinloop","sourcebytes":[67,111,110,116,105,110,117,101,32,115,116,97,116,101,109,101,110,116,32,110,111,116,32,105,110,32,108,111,111,112],"value":"Continue statement not in loop"},
+{"hash":197352304,"name":"jsparser.serrbreaknotinloop","sourcebytes":[66,114,101,97,107,32,115,116,97,116,101,109,101,110,116,32,110,111,116,32,105,110,32,108,111,111,112],"value":"Break statement not in loop"},
+{"hash":191166105,"name":"jsparser.serrreturnnotinfunction","sourcebytes":[114,101,116,117,114,110,32,115,116,97,116,101,109,101,110,116,32,110,111,116,32,105,110,32,97,32,102,117,110,99,116,105,111,110,32,98,111,100,121],"value":"return statement not in a function body"},
+{"hash":23193349,"name":"jsparser.serrcaseendexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,32,125,44,32,99,97,115,101,32,111,114,32,100,101,102,97,117,108,116,32,99,108,97,117,115,101],"value":"Unexpected token: Expected }, case or default clause"},
+{"hash":13475300,"name":"jsparser.serrduplicateswitchdefault","sourcebytes":[68,117,112,108,105,99,97,116,101,32,100,101,102,97,117,108,116,32,99,108,97,117,115,101,32,102,111,114,32,115,119,105,116,99,104,32,115,116,97,116,101,109,101,110,116],"value":"Duplicate default clause for switch statement"},
+{"hash":184227940,"name":"jsparser.serrnewlineafterthrow","sourcebytes":[78,101,119,108,105,110,101,32,97,102,116,101,114,32,116,104,114,111,119,32,110,111,116,32,97,108,108,111,119,101,100],"value":"Newline after throw not allowed"},
+{"hash":119278855,"name":"jsparser.serrcatchfinallyexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,32,39,99,97,116,99,104,39,32,111,114,32,39,102,105,110,97,108,108,121,39],"value":"Unexpected token: Expected 'catch' or 'finally'"},
+{"hash":191298851,"name":"jsparser.serrargumentsexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,32,39,44,39,32,111,114,32,39,41,39,44,32,103,111,116,32,37,115],"value":"Unexpected token: Expected ',' or ')', got %s"},
+{"hash":191085859,"name":"jsparser.serrarrayend","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,32,39,44,39,32,111,114,32,39,93,39,44,32,103,111,116,32,37,115],"value":"Unexpected token: Expected ',' or ']', got %s"},
+{"hash":57215715,"name":"jsparser.serrobjectelement","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,32,115,116,114,105,110,103,44,32,105,100,101,110,116,105,102,105,101,114,32,111,114,32,110,117,109,98,101,114,32,97,102,116,101,114,32,39,44,39,32,103,111,116,58,32,37,115],"value":"Unexpected token: Expected string, identifier or number after ',' got: %s"},
+{"hash":131110131,"name":"jsparser.serrliteralexpected","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,58,32,69,120,112,101,99,116,101,100,58,32,110,117,108,108,44,32,116,114,117,101,44,32,102,97,108,115,101,44,32,110,117,109,98,101,114,44,32,115,116,114,105,110,103,44,32,111,114,32,114,101,103,101,120,44,32,103,111,116,58,32,37,115],"value":"Unexpected token: Expected: null, true, false, number, string, or regex, got: %s"},
+{"hash":59232275,"name":"jsparser.serrinvalidnumber","sourcebytes":[73,110,118,97,108,105,100,32,110,117,109,101,114,105,99,97,108,32,118,97,108,117,101,58,32,37,115],"value":"Invalid numerical value: %s"},
+{"hash":57871699,"name":"jsparser.serrinvalidregularexpression","sourcebytes":[73,110,118,97,108,105,100,32,114,101,103,117,108,97,114,32,101,120,112,114,101,115,115,105,111,110,58,32,37,115],"value":"Invalid regular expression: %s"},
+{"hash":114755989,"name":"jsparser.serrfunctionnotallowedhere","sourcebytes":[102,117,110,99,116,105,111,110,32,107,101,121,119,111,114,100,32,110,111,116,32,97,108,108,111,119,101,100,32,104,101,114,101],"value":"function keyword not allowed here"}
+]}

BIN
compiler/packages/fcl-js/units/x86_64-linux/jsscanner.ppu


+ 11 - 0
compiler/packages/fcl-js/units/x86_64-linux/jsscanner.rsj

@@ -0,0 +1,11 @@
+{"version":1,"strings":[
+{"hash":182486439,"name":"jsscanner.serrinvalidcharacter","sourcebytes":[73,110,118,97,108,105,100,32,99,104,97,114,97,99,116,101,114,32,39,37,115,39],"value":"Invalid character '%s'"},
+{"hash":127311205,"name":"jsscanner.serropenstring","sourcebytes":[115,116,114,105,110,103,32,101,120,99,101,101,100,115,32,101,110,100,32,111,102,32,108,105,110,101],"value":"string exceeds end of line"},
+{"hash":253302231,"name":"jsscanner.serrincludefilenotfound","sourcebytes":[67,111,117,108,100,32,110,111,116,32,102,105,110,100,32,105,110,99,108,117,100,101,32,102,105,108,101,32,39,37,115,39],"value":"Could not find include file '%s'"},
+{"hash":68822384,"name":"jsscanner.serrifxxxnestinglimitreached","sourcebytes":[78,101,115,116,105,110,103,32,111,102,32,36,73,70,120,120,120,32,116,111,111,32,100,101,101,112],"value":"Nesting of $IFxxx too deep"},
+{"hash":159638344,"name":"jsscanner.serrinvalidppelse","sourcebytes":[36,69,76,83,69,32,119,105,116,104,111,117,116,32,109,97,116,99,104,105,110,103,32,36,73,70,120,120,120],"value":"$ELSE without matching $IFxxx"},
+{"hash":70085288,"name":"jsscanner.serrinvalidppendif","sourcebytes":[36,69,78,68,73,70,32,119,105,116,104,111,117,116,32,109,97,116,99,104,105,110,103,32,36,73,70,120,120,120],"value":"$ENDIF without matching $IFxxx"},
+{"hash":116288578,"name":"jsscanner.sinvalidhexadecimalnumber","sourcebytes":[73,110,118,97,108,105,100,32,100,101,99,105,109,97,108,32,110,117,109,98,101,114],"value":"Invalid decimal number"},
+{"hash":62373892,"name":"jsscanner.serrinvalidnonequal","sourcebytes":[83,121,110,116,97,120,32,69,114,114,111,114,58,32,33,61,32,111,114,32,33,61,61,32,101,120,112,101,99,116,101,100],"value":"Syntax Error: != or !== expected"},
+{"hash":113051875,"name":"jsscanner.serrinvalidregularexpression","sourcebytes":[83,121,110,116,97,120,32,101,114,114,111,114,32,105,110,32,114,101,103,117,108,97,114,32,101,120,112,114,101,115,115,105,111,110,58,32,47,32,101,120,112,101,99,116,101,100,44,32,103,111,116,58,32,37,115],"value":"Syntax error in regular expression: \/ expected, got: %s"}
+]}

BIN
compiler/packages/fcl-js/units/x86_64-linux/jssrcmap.ppu


BIN
compiler/packages/fcl-js/units/x86_64-linux/jstoken.ppu


BIN
compiler/packages/fcl-js/units/x86_64-linux/jstree.ppu


BIN
compiler/packages/fcl-js/units/x86_64-linux/jswriter.ppu


+ 4 - 0
compiler/packages/fcl-js/units/x86_64-linux/jswriter.rsj

@@ -0,0 +1,4 @@
+{"version":1,"strings":[
+{"hash":207371923,"name":"jswriter.serrunknownjsclass","sourcebytes":[85,110,107,110,111,119,110,32,106,97,118,97,115,99,114,105,112,116,32,101,108,101,109,101,110,116,32,99,108,97,115,115,32,58,32,37,115],"value":"Unknown javascript element class : %s"},
+{"hash":30371892,"name":"jswriter.serrnilnode","sourcebytes":[78,105,108,32,110,111,100,101,32,105,110,32,74,97,118,97,115,99,114,105,112,116],"value":"Nil node in Javascript"}
+]}

+ 2561 - 0
compiler/packages/fcl-json/Makefile

@@ -0,0 +1,2561 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+ifeq ($(OS_SOURCE),darwin)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=fcl-json
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+EXEDBGEXT=.dbg
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),wasm-wasm)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
+override FPCOPT+=-Cg
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 102 - 0
compiler/packages/fcl-json/Makefile.fpc

@@ -0,0 +1,102 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=fcl-json
+version=3.3.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources and omits the location of the source-
+# files from the fpunits.cfg files.
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 33 - 0
compiler/packages/fcl-json/Makefile.fpc.fpcmake

@@ -0,0 +1,33 @@
+#
+#   Makefile.fpc for XML for FCL
+#
+
+[package]
+name=fcl-json
+version=3.3.1
+
+[target]
+units=fpjson jsonscanner jsonparser jsonconf fpjsonrtti
+rsts=fpjson jsonscanner jsonparser jsonconf fpjsonrtti
+
+[require]
+packages=fcl-base
+
+[compiler]
+options=-S2h
+sourcedir=src
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+.NOTPARALLEL:
+
+jsonparser$(PPUEXT): jsonparser.pp fpjson$(PPUEXT) jsonscanner$(PPUEXT)
+
+jsonconf$(PPUEXT): jsonparser$(PPUEXT) fpjson$(PPUEXT)
+
+fpjsonrtti$(PPUEXT): jsonparser$(PPUEXT) fpjson$(PPUEXT)

+ 46 - 0
compiler/packages/fcl-json/examples/confdemo.lpi

@@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="confdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="confdemo"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="../src/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

+ 101 - 0
compiler/packages/fcl-json/examples/confdemo.pp

@@ -0,0 +1,101 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Config file demo
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program confdemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes,
+  { add your units here }
+  jsonconf;
+
+Procedure TestConf;
+
+Var
+  C : TJSONConfig;
+  L : TStrings;
+  I : Integer;
+  
+begin
+  // TJSONConf is component, so needs an owner.
+  C:=TJSONConfig.Create(nil);
+  Try
+    // Set filename. This will read the file.
+    C.FileName:='sample.conf';
+    // Set an integer value "a" equal to 1 in the root object
+    C.SetValue('/a',1);
+    // Set a integer value "a" equal to 2 in the object "b" below root.
+    C.SetValue('b/a',2);
+    // Set a string value "b" equal to 1 in the object "b" below root.
+    C.SetValue('b/b','Some String');
+    // Set a float value "c" equal to 1.23 in the object "b" below root.
+    C.SetValue('b/c',1.23);
+    // Set a boolean value "d" equal to "False" in the object "b" below root.
+    C.SetValue('b/d',False);
+    // Read values:
+    // Integer. If none found, 0 is returned)
+    Writeln('/a :',C.GetValue('/a',0));
+    // String. If none found, a default 'XYZ' is returned)
+    Writeln('/b/b :',C.GetValue('/b/b','XYZ'));
+    // Float. If none found, 0 is returned)
+    Writeln('/b/c :',C.GetValue('/b/c',0));
+    // Boolean. If none found, true is returned)
+    Writeln('/b/d :',C.GetValue('/b/d',true));
+    // You can open a key. All paths are then relative to the open key.
+    // The default open key is the root key.
+    // The second element determines if the key should b created if it does not exist.
+    C.OpenKey('/b',False);
+    // Read relative to b
+    Writeln('a, relative to key (/b):',C.GetValue('a',0));
+    // Absolute paths disregard the open key
+    Writeln('/a, absolute:',C.GetValue('/a',0));
+    // Reset or closekey reset the open key to the root key.
+    C.OpenKey('/b/c/d/e',True);
+    C.SetValue('q','Q is good for you');
+    // Opening keys also works relative:
+    C.OpenKey('/b',False);
+    Writeln('a, in b : ',C.GetValue('a',0));
+    C.OpenKey('c/d/e',False);
+    Writeln('q, in /b, then c/d/e : ',C.GetValue('q',''));
+    C.ResetKey;
+    C.OpenKey('/b2',True);
+    C.OpenKey('/b3',True);
+    L:=TStringList.Create;
+    try
+      // You can enumerate keys below a certain key:
+      C.EnumSubKeys('/',L);
+      Writeln('Found ',L.Count,' keys below root key: ');
+      For I:=0 to L.Count-1 do
+        Writeln(i+1,': ',L[I]);
+      // You can also enumerate the values below a certain key:
+      L.Clear;
+      C.EnumValues('/b',L);
+      Writeln('Found ',L.Count,' values below "/b" key: ');
+      For I:=0 to L.Count-1 do
+        Writeln(i+1,': ',L[I]);
+    finally
+      L.Free;
+    end;
+    // Write all in-memory changes to disk
+    C.Flush;
+  Finally
+    C.Free;
+  end;
+end;
+
+begin
+  TestConf;
+end.
+

+ 21 - 0
compiler/packages/fcl-json/examples/demoformat.pp

@@ -0,0 +1,21 @@
+{$mode objfpc}
+{$h+}
+program demoformat;
+
+uses fpjson;
+
+var
+  O : TJSONObject;
+  A : TJSONArray;  
+begin  
+  O:=TJSONObject.Create(['a',1,'b','two','three',TJSONObject.Create(['x',10,'y',20])]);
+  Writeln (O.FormatJSon);
+  Writeln (O.FormatJSon([foDonotQuoteMembers,foUseTabChar],1));
+  Writeln (O.FormatJSon([foSingleLineObject,foUseTabChar],1));
+  Writeln (O.asJSON);
+  A:=TJSONArray.Create([1,2,'a',TJSONObject.Create(['x',10,'y',20])]);
+  Writeln (A.FormatJSon());
+  Writeln (A.FormatJSON([foSinglelineArray],2));
+  Writeln (A.FormatJSON([foSinglelineArray,foSingleLineObject],2));
+  Writeln (A.asJSON);
+end.  

+ 362 - 0
compiler/packages/fcl-json/examples/demortti.pp

@@ -0,0 +1,362 @@
+program demortti;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpjson, fpjsonrtti, variants;
+
+Var
+  JS : TJSONStreamer;
+
+Type
+
+  { TTestItem }
+
+  TTestItem = Class(TCollectionItem)
+  private
+    FStrProp: String;
+  Published
+    Property StrProp : String Read FStrProp Write FStrProp;
+  end;
+
+  { TCollComponent }
+
+  TCollComponent = Class(TComponent)
+  private
+    FCollProp: TCollection;
+  Published
+   Property CollProp : TCollection Read FCollProp Write FCollProp;
+  end;
+
+  { TCompComponent }
+
+  TCompComponent = Class(TComponent)
+  private
+    FCompProp: TComponent;
+  Published
+   Property CompProp : TComponent Read FCompProp Write FCompProp;
+  end;
+
+  TDice = (one,two,three,four,five,six);
+  TThrow = Set of TDice;
+
+  { TEnumComponent }
+
+  TEnumComponent = Class(TComponent)
+  private
+    FDice: TDice;
+  Published
+    Property Dice : TDice Read FDice Write FDice;
+  end;
+
+  { TSetComponent }
+
+  TSetComponent = Class(TComponent)
+  private
+    FThrow: TThrow;
+  Published
+    Property Throw : TThrow Read FThrow Write FThrow;
+  end;
+
+  { TChildComponent }
+
+  TChildComponent = Class(TComponent)
+  Protected
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+  end;
+
+  { TChildComponent }
+
+  procedure TChildComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+  Var
+    I : Integer;
+
+  begin
+    Writeln('Children',ComponentCount);
+    For I:=0 to ComponentCount-1 do
+      Proc(Components[i]);
+  end;
+
+
+Procedure DumpObject(const Header : String; var O : TJSONData);
+
+begin
+  Writeln(Header,' : ');
+  Writeln(O.FormatJSON());
+  writeln();
+  FreeAndNil(O);
+  JS.Options:=[];
+end;
+
+Procedure DemoObject;
+
+Var
+  C : TComponent;
+  O : TJSONData;
+
+begin
+  C:=TComponent.Create(Nil);
+  try
+    C.Name:='DemoComponent';
+    C.Tag:=23;
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Complete component',O);
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoComponentObject;
+
+Var
+  C : TCompComponent;
+  O : TJSONData;
+
+begin
+  C:=TCompComponent.Create(Nil);
+  try
+    C.Name:='DemoComponent';
+    C.Tag:=23;
+    C.CompProp:=TCompComponent.Create(C);
+    C.CompProp.Name:='SubComponent';
+    C.CompProp.Tag:=45;
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Component-valued property',O);
+    TCompComponent(C.CompProp).FComponentStyle:=[csSubComponent];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Component-valued property, csSubComponent in Componentstyle',O);
+    TCompComponent(C.CompProp).FComponentStyle:=[];
+    JS.options:=[jsoComponentsInline];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Component-valued property, options:=[jsoComponentsInline] ',O);
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoChildObject;
+
+Var
+  C : TChildComponent;
+  O : TJSONData;
+
+begin
+  C:=TChildComponent.Create(Nil);
+  try
+    C.Name:='ParentComponent';
+    C.Tag:=23;
+    With TComponent.Create(C) do
+      begin
+      Name:='Child1';
+      Tag:=1;
+      end;
+    With TComponent.Create(C) do
+      begin
+      Name:='Child2';
+      Tag:=2;
+      end;
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Component with children, default options',O);
+    JS.Options:=[jsoStreamChildren];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Component with children, Options:=[jsoStreamChildren]',O);
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoEnumObject;
+
+Var
+  C : TEnumComponent;
+  O : TJSONData;
+
+begin
+  C:=TEnumComponent.Create(Nil);
+  try
+    C.Dice:=Three;
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Enumerated-typed property, default settings',O);
+    JS.Options:=[jsoEnumeratedAsInteger];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Enumerated-typed property, Options:=[jsoEnumeratedAsInteger];',O);
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoSetObject;
+
+Var
+  C : TSetComponent;
+  O : TJSONData;
+
+begin
+  C:=TSetComponent.Create(Nil);
+  try
+    C.Throw:=[two,five];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('set-typed property, default settings',O);
+    JS.Options:=[jsoSetAsString];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Set-typed property, Options:=[jsoSetAsString];',O);
+    JS.Options:=[jsoSetAsString,jsoSetBrackets];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Set-typed property, Options:=[jsoSetAsString,jsoSetBrackets];',O);
+    JS.Options:=[jsoSetEnumeratedAsInteger];
+    O:=JS.ObjectToJSON(C);
+    DumpObject('Set-typed property, Options:=[jsoSetEnumeratedAsInteger];',O);
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoObjectAsString;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TComponent.Create(Nil);
+  try
+    C.Name:='DemoComponent';
+    C.Tag:=23;
+    Writeln('Complete component, directly as string :');
+    Writeln(JS.ObjectToJSONString(C));
+    JS.Options:=[jsoUseFormatString];
+    Writeln('Complete component, directly as string (Options:=[jsoUseFormatString]):');
+    Writeln(JS.ObjectToJSONString(C));
+    JS.Options:=[];
+    Writeln('');
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+Procedure DemoStrings;
+
+Var
+  S : TStrings;
+  O : TJSONData;
+  C : TComponent;
+
+begin
+  S:=TStringList.Create;
+  try
+    S.Add('One');
+    S.Add('two');
+    S.Add('Three');
+    O:=JS.StreamTStrings(S);
+    DumpObject('Default TStrings',O);
+    O:=JS.StreamTStringsArray(S);
+    DumpObject('TStrings as array',O);
+    C:=TComponent.Create(Nil);
+    try
+      C.Name:='SubComponent';
+      C.Tag:=12;
+      S.Objects[0]:=C;
+      O:=JS.StreamTStringsObject(S);
+      DumpObject('TStrings as object',O);
+      Writeln('TStrings Directly as JSON string, array');
+      Writeln(JS.StringsToJSON(S,False));
+      Writeln();
+      Writeln('TStrings Directly as JSON string, object');
+      Writeln(JS.StringsToJSON(S,True));
+      Writeln();
+      O:=JS.ObjectToJSON(S);
+      DumpObject('Passing TStrings to ObjctToJSON',O);
+      JS.Options:=[jsoTstringsAsArray];
+      O:=JS.ObjectToJSON(S);
+      DumpObject('Passing TStrings to ObjctToJSON (Options:=[jsoTstringsAsArray])',O);
+      JS.Options:=[jsoTstringsAsObject];
+      O:=JS.ObjectToJSON(S);
+      DumpObject('Passing TStrings to ObjctToJSON (Options:=[jsoTstringsAsObject])',O);
+    finally
+      FreeAndNil(C);
+    end;
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
+Procedure DemoCollection;
+
+Var
+  C : TCollection;
+  CC : TCollComponent;
+  O : TJSONData;
+
+begin
+  C:=TCollection.Create(TTestItem);
+  try
+    (C.Add as TTestItem).StrProp:='One';
+    (C.Add as TTestItem).StrProp:='Two';
+    (C.Add as TTestItem).StrProp:='Three';
+    CC:=TCollComponent.Create(Nil);
+    try
+      CC.CollProp:=C;
+      O:=JS.ObjectToJSON(CC);
+      DumpObject('Collection property',O);
+      O:=JS.StreamCollection(C);
+      DumpObject('StreamCollection result',O);
+      O:=JS.ObjectToJSON(C);
+      DumpObject('Passing collection to ObjectToJSON (returns an object)',O);
+      Writeln('Direct Collection to JSON String :');
+      Writeln(JS.CollectionToJSON(C));
+      Writeln;
+    finally
+      FreeAndNil(CC);
+    end;
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+
+Procedure DemoVariant;
+
+Var
+  V : Variant;
+  O : TJSONData;
+  I : integer;
+
+begin
+  V:=3;
+  O:=JS.StreamVariant(V);
+  DumpObject('Simple integer variant streaming',O);
+  V:=EncodeDate(2010,12,24);
+  O:=JS.StreamVariant(V);
+  DumpObject('Date variant streaming',O);
+  JS.Options:=[jsoDateTimeAsString];
+  O:=JS.StreamVariant(V);
+  DumpObject('Date variant streaming (Options:=[jsoDateTimeAsString];)',O);
+  V:=VarArrayCreate([1,10],varInteger);
+  For I:=1 to 10 do
+    V[i]:=11-I;
+  O:=JS.StreamVariant(V);
+  DumpObject('Variant arrays also work',O);
+  Writeln('Variant to JSON string :');
+  Writeln(JS.VariantToJSON(V));
+  Writeln('Variant to JSON string, with formatting :');
+  JS.Options:=[jsoUseFormatString];
+  Writeln(JS.VariantToJSON(V));
+  JS.Options:=[];
+end;
+
+begin
+  JS:=TJSONStreamer.Create(Nil);
+  try
+    DemoObject;
+    DemoObjectAsString;
+    DemoComponentObject;
+    DemoEnumObject;
+    DemoSetObject;
+    DemoStrings;
+    DemoCollection;
+    DemoVariant;
+    DemoChildObject;
+  Finally
+    FreeAndNil(JS);
+  end;
+end.

+ 22 - 0
compiler/packages/fcl-json/examples/ini2json.pp

@@ -0,0 +1,22 @@
+program ini2json;
+
+{$mode objfpc}
+{$h+1}
+
+uses sysutils,jsonini;
+
+var
+  fin,fout : string;
+
+begin
+  if (ParamCount<1) then
+    begin
+    Writeln('Usage : ',ExtractFileName(ParamStr(0)),' infile [outfile]');
+    Halt(1);
+    end;
+  Fin:=ParamStr(1);  
+  FOut:=ParamStr(2);  
+  If (Fout='') then
+    Fout:=ChangeFileExt(Fin,'.json');
+  TJSONIniFile.ConvertIni(Fin,Fout,False);  
+end.

+ 52 - 0
compiler/packages/fcl-json/examples/j2y.pp

@@ -0,0 +1,52 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2017 by Michael Van Canneyt [email protected]
+
+    JSON To YAML syntax converter demo
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program j2y;
+{$MODE OBJFPC}
+{$H+}
+
+uses fpjson,classes, jsonparser,json2yaml,sysutils;
+
+Var
+  IFN,OFN : String;
+  D : TJSONData;
+  IFS,OFS : TStream;
+  jtoy : TJSONToYaml;
+
+
+begin
+  If ParamCount=0 then
+    writeln('Usage j2y infile [outfile]');
+  IFN:=ParamStr(1);
+  OFN:=ParamStr(2);
+  if OFN='' then
+    OFN:=Changefileext(IFN,'yaml');
+  D:=Nil;
+  OFS:=Nil;
+  jtoy:=Nil;
+  IFS:=TFileStream.Create(IFN,fmOpenRead or fmShareDenyWrite);
+  try
+    D:=GetJSON(IFS);
+    OFS:=TFileStream.Create(OFN,fmCreate);
+    JTOY:=TJSONToYaml.Create;
+    JTOY.Convert(D,OFS);
+  finally
+    D.Free;
+    IFS.Free;
+    OFS.Free;
+    JTOY.Free;
+  end;
+
+end.
+

+ 46 - 0
compiler/packages/fcl-json/examples/parsedemo.lpi

@@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="parsedemo.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="parsedemo"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="../src/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

+ 137 - 0
compiler/packages/fcl-json/examples/parsedemo.pp

@@ -0,0 +1,137 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Parser demo
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program parsedemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpjson,jsonparser;
+
+Procedure DoParse(P : TJSONParser);
+
+Var
+  J : TJSONData;
+  
+begin
+  Try
+    J:=P.Parse;
+    Try
+      Writeln('Parse succesful. Dumping JSON data : ');
+      If Assigned(J) then
+        begin
+        Writeln('Returned JSON structure has class : ',J.ClassName);
+        Writeln(J.AsJSON)
+        end
+      else
+        Writeln('No JSON data available');
+    Finally
+      FreeAndNil(J);
+    end;
+  except
+    On E : Exception do
+      Writeln('An Exception occurred when parsing : ',E.Message);
+  end;
+end;
+
+
+Procedure ParseFile (FileName : String);
+
+Var
+  F : TFileStream;
+  P : TJSONParser;
+
+begin
+  F:=TFileStream.Create(FileName,fmopenRead);
+  try
+    // Create parser with Stream as source.
+    P:=TJSONParser.Create(F);
+    try
+      DoParse(P);
+    finally
+      FreeAndNil(P);
+    end;
+  finally
+    F.Destroy;
+  end;
+end;
+
+Procedure ParseString(S : String);
+
+Var
+  P : TJSONParser;
+begin
+  // Create parser with Stream as source.
+  P:=TJSONParser.Create(S);
+  try
+    DoParse(P);
+  finally
+    FreeAndNil(P);
+  end;
+end;
+
+Procedure DefaultParsing;
+
+Const
+  // From JSON website
+ SAddr ='{ "addressbook": { "name": "Mary Lebow", '+
+         '  "address": {'+
+         '      "street": "5 Main Street",'+LineEnding+
+         '        "city": "San Diego, CA",'+LineEnding+
+         '        "zip": 91912,'+LineEnding+
+         '    },'+LineEnding+
+         '    "phoneNumbers": [  '+LineEnding+
+         '        "619 332-3452",'+LineEnding+
+         '        "664 223-4667"'+LineEnding+
+         '    ]'+LineEnding+
+         ' }'+LineEnding+
+         '}';
+
+
+begin
+  ParseString('');
+  ParseString('NULL');
+  ParseString('1');
+  ParseString('2.3');
+  ParseString('True');
+  ParseString('False');
+  ParseString('"A string"');
+  ParseString('[ Null, False, 1 , 2.3,  "a" , { "b" : 1 }]');
+  ParseString('{ "a" : 1, "b" : "Something" }');
+  ParseString(SAddr);
+end;
+
+Procedure Usage;
+
+begin
+  Writeln('Usage : parsedemo arg1 [arg2 [arg3 ...[argN]]]');
+  Writeln('  ArgN can be the name of an existing file, or a JSON string');
+end;
+
+Var
+  I : Integer;
+  
+begin
+  If (ParamCount=0) then
+    DefaultParsing
+  else if (ParamCount=1) and ((Paramstr(1)='-h') or (ParamStr(1)='--help')) then
+    Usage
+  else
+    For I:=1 to ParamCount do
+      If FileExists(Paramstr(i)) then
+        ParseFile(ParamStr(I))
+      else
+        ParseString(Paramstr(I));
+end.
+

+ 46 - 0
compiler/packages/fcl-json/examples/simpledemo.lpi

@@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="simpledemo.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="simpledemo"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="../src/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

+ 331 - 0
compiler/packages/fcl-json/examples/simpledemo.pp

@@ -0,0 +1,331 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Data structures demo
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program simpledemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, fpjson;
+
+Procedure DumpJSONData(J : TJSonData; DOEOLN : Boolean = True);
+
+Var
+  I : Integer;
+
+begin
+  // JSONType property determines kind of value.
+  Case J.jsontype of
+    jtNull   : Write('Null');
+    jtBoolean : If J.AsBoolean then
+                  Write('True')
+                else
+                  Write('False');
+    jtNumber : {JSONNumber has extra NumberType property
+                which determines kind of value (int/float).}
+               Case TJSONNumber(J).NumberType of
+                 ntInteger : Write(J.AsInteger);
+                 ntFloat   : Write(J.AsFloat:10:2);
+               end;
+    jtString : Write('"',J.AsString,'"');
+    jtArray  : begin
+               Write('[ ');
+               For I:=0 to J.Count-1 do
+                 begin
+                 DumpJSONData(J.Items[I],False);
+                 If I<J.Count-1 then
+                   Write(', ');
+                 end;
+               Write(' ]');
+               end;
+    jtObject : begin
+               Write('{ ');
+               For I:=0 to J.Count-1 do
+                 begin
+                 Writeln('"',TJSONObject(J).Names[i],'" : ');
+                 DumpJSONData(J.Items[I],False);
+                 If I<J.Count-1 then
+                   Write(',')
+                 end;
+               Write('}');
+               end;
+   end;
+   If DOEOLN then
+     Writeln;
+end;
+
+
+Procedure EndTest(Msg : String;J : TJSOnData);
+
+begin
+  Write(Msg, ' : ');
+  DumpJSONData(J);
+  FreeAndNil(J);
+end;
+
+Procedure DoTestCreate;
+
+
+begin
+  Writeln('Constructor tests');
+  EndTest('Null value',TJSOnNull.Create);
+  EndTest('Boolean true',TJSONBoolean.Create(True));
+  EndTest('Boolean false',TJSONBoolean.Create(False));
+  EndTest('Integer value',TJSONIntegerNumber.Create(100));
+  EndTest('Float value',TJSONFloatNumber.Create(1.2e3));
+  EndTest('String value',TJSONString.Create('Some weird JSON string'));
+  EndTest('Empty Array value',TJSONArray.Create);
+  EndTest('Array value from array of const',TJSONArray.Create([1,'a',2,'b']));
+  EndTest('Empty Object value',TJSONObject.Create);
+  // Name, Value, name, value
+  EndTest('Object from array of const',TJSONObject.Create(['a',1,'b',True,'C',Nil]));
+
+end;
+
+Procedure DoTestAs;
+
+Var
+  J : TJsonData;
+
+begin
+  Writeln('AsNNN value accessing tests, number with value 123:');
+  J:=TJSonIntegerNumber.Create(123);
+  Writeln('IsNull    : ',J.IsNull);
+  Writeln('AsInteger : ',J.AsInteger);
+  Writeln('AsBoolean : ',J.AsBoolean);
+  Writeln('AsString  : ',J.AsString);
+  Writeln('AsFloat   : ',J.AsFloat:5:3);
+  FreeAndNil(J);
+  Writeln('Test IsNull');
+  J:=TJSonNull.Create;
+  Writeln('Test for null with IsNull');
+  Writeln('IsNull : ',J.ISNull);
+  Writeln('Test number of children :');
+  Writeln('Count (0) : ',J.Count);
+  FreeAndNil(J);
+  J:=TJSONArray.Create(['a','b','c']);
+  Writeln('Count (3): ',J.Count);
+  FreeAndNil(J);
+  J:=TJSONObject.Create(['a',1,'b',2]);
+  Writeln('Count (2): ',J.Count);
+  FreeAndNil(J);
+end;
+
+Procedure DoTestArray;
+
+Var
+  J : TJSOnArray;
+  I : Integer;
+
+begin
+  Writeln('JSON array with elements 0,1,2,3');
+  J:=TJSONArray.Create([0,1,2,3]);
+  Write('Access through Elements[] (default) array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J[I].AsString);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Nulls[] array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J.Nulls[I]);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Booleans[] array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J.Booleans[I]);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Integers[] array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J.Integers[I]);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Floats[] array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J.Floats[I]:5:2);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Strings[] array property : ');
+  For I:=0 to J.Count-1 do
+    begin
+    Write(J.Strings[I]);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create with 3 empty TJSONObjects in array constructor');
+  Write('Access through Objects[] array property : ');
+  J:=TJSONArray.Create([TJSOnObject.Create,TJSOnObject.Create,TJSOnObject.Create]);
+  For I:=0 to J.Count-1 do
+    begin
+    DumpJSONData(J.Objects[I],False);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create with 3 empty TJSONArrays in array constructor');
+  Write('Access through Arrays[] array property : ');
+  J:=TJSONArray.Create([TJSOnArray.Create,TJSOnArray.Create,TJSOnArray.Create]);
+  For I:=0 to J.Count-1 do
+    begin
+    DumpJSONData(J.Arrays[I],False);
+    If I<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create empty array. Add elements with overloaded Add() method');
+  J:=TJSONArray.Create;
+  J.Add; // Null
+  J.Add(True);
+  J.Add(False);
+  J.Add(123);
+  J.Add(2.34);
+  J.Add('A string');
+  J.Add(TJSOnArray.Create);
+  J.Add(TJSOnObject.Create);
+  DumpJSONData(J);
+  FreeAndNil(J);
+end;
+
+Procedure DoTestObject;
+
+Var
+  J : TJSONObject;
+  I : Char;
+  k : Integer;
+  
+begin
+  Writeln('JSON object with elements a=0,b=1,c=2,d=3');
+  J:=TJSONObject.Create(['a',0,'b',1,'c',2,'d',3]);
+  Write('Get element names with Names[] array property : ');
+  For K:=1 to J.Count-1 do
+    begin
+    Write(J.Names[k]);
+    If K<J.Count-1 then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Elements[] (default) array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J[I].AsString);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Nulls[] array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J.Nulls[I]);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Booleans[] array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J.Booleans[I]);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Integers[] array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J.Integers[I]);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Floats[] array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J.Floats[I]:5:2);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  Write('Access through Strings[] array property : ');
+  For I:='a' to 'd' do
+    begin
+    Write(i,' : ',J.Strings[I]);
+    If I<'d' then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create with 3 empty TJSONObjects in array constructor');
+  Write('Access through Objects[] array property : ');
+  J:=TJSONObject.Create(['a',TJSOnObject.Create,'b',TJSOnObject.Create,'c',TJSOnObject.Create]);
+  For I:='a' to 'c' do
+    begin
+    Write(i,' : ');
+    DumpJSONData(J.Objects[i],False);
+    If I<'c' then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create with 3 empty TJSONArrays in array constructor');
+  Write('Access through Arrays[] array property : ');
+  J:=TJSONObject.Create(['a',TJSONArray.Create,'b',TJSONArray.Create,'c',TJSONArray.Create]);
+  For I:='a' to 'c' do
+    begin
+    Write(i,' : ');
+    DumpJSONData(J.Arrays[I],False);
+    If I<'c' then
+      Write(', ');
+    end;
+  Writeln;
+  FreeAndNil(J);
+  Writeln('Create empty object. Add elements with overloaded Add() method');
+  J:=TJSONObject.Create;
+  J.Add('a'); // Null
+  J.Add('b',True);
+  J.Add('c',False);
+  J.Add('d',123);
+  J.Add('e',2.34);
+  J.Add('f','A string');
+  J.Add('g',TJSONArray.Create);
+  J.Add('h',TJSOnObject.Create);
+  DumpJSONData(J);
+  FreeAndNil(J);
+end;
+
+
+begin
+  DoTestCreate;
+  DoTestAs;
+  DoTestArray;
+  DoTestObject;
+end.
+

+ 10 - 0
compiler/packages/fcl-json/fcl-json-x86_64-linux.fpm

@@ -0,0 +1,10 @@
+Name=fcl-json
+Version=3.3.1
+Checksum=1549701248
+CPU=x86_64
+OS=linux
+SourcePath=/home/mattias/pascal/fpc_sources/3.3.1/fpc/packages/fcl-json/
+FPMakeOptions=-o -Ur -o -Xs -o -O2 -o -n -o -Cg -o -dx86_64 -o -dRELEASE -o -XX -o -CX
+Depends=rtl,fcl-base|1549701242,rtl-objpas|1549701241
+NeedLibC=N
+FPMakeAddIn=N

+ 111 - 0
compiler/packages/fcl-json/fpmake.pp

@@ -0,0 +1,111 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  T : TTarget;
+  P : TPackage;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('fcl-json');
+    P.ShortName:='fclj';
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.3.1';
+    P.Dependencies.Add('fcl-base');
+    P.Dependencies.Add('rtl-objpas');
+    P.Author := 'Michael van Canneyt';
+    P.License := 'LGPL with modification, ';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Json interfacing, part of Free Component Libraries (FCL), FPC''s OOP library.';
+    P.NeedLibC:= false;
+    P.OSes:=AllOSes-[embedded,msdos,win16,macos,palmos];
+    if Defaults.CPU=jvm then
+      P.OSes := P.OSes - [java,android];
+
+    P.SourcePath.Add('src');
+
+    T:=P.Targets.AddUnit('fpjson.pp');
+    T.ResourceStrings:=true;
+
+    T:=P.Targets.AddUnit('jsonconf.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+     end;
+        
+    T:=P.Targets.AddUnit('jsonparser.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonscanner');
+      AddUnit('jsonreader');
+      end;
+    T:=P.Targets.AddUnit('jsonreader.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonscanner');
+      end;
+        
+    T:=P.Targets.AddUnit('jsonscanner.pp');
+    T.ResourceStrings:=true;
+    
+    T:=P.Targets.AddUnit('fpjsonrtti.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+      end;
+      
+    T:=P.Targets.AddUnit('fpjsontopas.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+      end;
+
+    T:=P.Targets.AddUnit('jsonini.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+     end;
+    T:=P.Targets.AddUnit('json2yaml.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+     end;
+
+    P.ExamplePath.Add('examples');
+    T:=P.Targets.AddExampleProgram('confdemo.pp');
+    T:=P.Targets.AddExampleProgram('parsedemo.pp');
+    T:=P.Targets.AddExampleProgram('simpledemo.pp');
+    T:=P.Targets.AddExampleProgram('ini2json.pp');
+    T:=P.Targets.AddExampleProgram('j2y.pp');
+
+    // simpledemo.lpi
+    // confdemo.lpi
+    // parsedemo.lpi
+
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}
+
+
+

+ 229 - 0
compiler/packages/fcl-json/src/README.txt

@@ -0,0 +1,229 @@
+This package implements JSON support for FPC.
+
+You might want to have a look at the lazarus jsonviewer tool, written using
+fpJSON (see lazarus/tools/jsonviewer). It visualizes the fpJSON data and
+shows how to program using fpjson.
+
+JSON support consists of 3 parts:
+
+unit fpJSON contains the data representation. Basically, it defines a set of
+classes:
+
+TJSONData
++- TJSONNumber
+   +- TJSONIntegerNumber
+   +- TJSONFloatNumber
+   +- TJSONInt64Number
++- TJSONString
++- TJSONBoolean
++- TJSONNull
++- TJSONObject
++- TJSONArray
+
+The TJSONData.JSONType property is an enumerated:
+TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
+
+Which allows to determine the type of a value.
+
+The following methods exist:
+
+Procedure Clear;
+  Clears the value. For arrays and objects, removes all elements/members
+Function Clone : TJSONData;
+  Creates an exact replica of the valye
+property Count: Integer;
+  For simple values this is zero, for complex values this is the number of
+  elements/members. Read only.
+property Items[Index: Integer]: TJSONData
+  For simple values, reading this will result in an error. For complex
+  values, this gives access to the members.
+property Value: variant;
+  The value as a variant. Only for simple values.
+Property AsString : TJSONStringType:
+   The value as a string. Only for simple values.
+Property AsFloat : TJSONFloat;
+  The value as a float (double). only for simple values.
+Property AsInteger : Integer ;
+  The value as an integer. only for simple values.
+Property AsInt64 : Int64;
+  The value as an 64-bit integer. only for simple values.
+Property AsBoolean : Boolean ;
+  The value as a boolean.
+Property IsNull : Boolean ;
+  Is the value Null ?
+Property AsJSON : TJSONStringType 
+  Return the value in JSON notation. For simple and complex values.
+
+The TJSONArray type provides access to the elements in the array in the
+following ways:
+
+Property Types[Index : Integer] : TJSONType;
+ Indexed access to the types of the elements in the array.
+Property Nulls[Index : Integer] : Boolean 
+ Checks if the Index-the element is NULL.
+Property Integers[Index : Integer] : Integer
+  Read/Write element values as integers.
+Property Int64s[Index : Integer] : Int64 
+  Read/Write element values as 64-bit integers.
+Property Strings[Index : Integer] : TJSONStringType;
+  Read/Write element values as strings.
+Property Floats[Index : Integer] : TJSONFloat ;
+  Read/Write element values as floats (doubles).
+Property Booleans[Index : Integer] : Boolean;
+  Read/Write element values as booleans.
+Property Arrays[Index : Integer] : TJSONArray;
+  Read/Write element values as arrays.
+Property Objects[Index : Integer] : TJSONObject;
+  Read/Write element values a strings
+
+Reading an element as a type which is incompatible, will result in an
+exception. For instance if element 5 is an object value, then the following
+will result in an exception:
+  i:=i+Array.Integers[5]
+
+The TJSONObject type similarly provides access to the elements in the array
+using the member names:
+property Names[Index : Integer] : TJSONStringType;
+  Indexed access to the member names.
+property Elements[AName: string] : TJSONData;
+  Read/Write a member as a raw TJSONData value.
+Property Types[AName : String] : TJSONType Read GetTypes;
+  Read/Write the type of a member.
+Property Nulls[AName : String] : Boolean;
+  Read/Write a member as a NULL value.
+Property Floats[AName : String] : TJSONFloat;
+  Read/Write a member as a float value (double)
+Property Integers[AName : String] : Integer;
+  Read/Write a member as an integer value
+Property Int64s[AName : String] : Int64;
+  Read/Write a member as an 64-bit integer value
+Property Strings[AName : String] : TJSONStringType;
+  Read/Write a member as a string value.
+Property Booleans[AName : String] : Boolean;
+  Read/Write a member as a boolean value.
+Property Arrays[AName : String] : TJSONArray;
+  Read/Write a member as an array value.
+Property Objects[AName : String] : TJSONObject
+  Read/Write a member as an object value.
+
+Members can be added with the Add() call, which exists in various overloaded
+forms:
+   function Add(const AName: TJSONStringType; Const AValue): Integer;
+Where the type of AVAlue is one of the supported types: 
+integer, int64, double, string, TJSONArray or TJSONObject.
+
+The Delete() call deletes an element from an array or object. The element is
+freed.
+
+Important remark:
+The array and object classes own their members: the members are destroyed as
+they are deleted. For this, the Extract() call exists: it removes an
+element/member from the array/object, without destroying it.
+
+Converting from string/stream to JSONData
+=========================================
+
+The fpjson unit contains a GetJSON() function which accepts a string or a
+stream as a parameter. The function will parse the JSON in the stream and 
+the return value is a TJSONData value corresponding to the JSON.
+The function works with a callback, which is set by the JSONParser unit.
+The JSONParser unit simply needs to be included in the project.
+
+The parsing happens with default settings for the parser class.
+You can override this behaviour by creating your own callback, 
+and creating the parser with different settings.
+
+Enumerator support
+==================
+
+the TJSONData class offers support for an enumerator, hence the 
+For e in JSON do
+construct can be used. The enumerator is a TJSONEnum value, which has 3
+members:
+Key : The key of the element 
+     (name in TJSONObject, Index in TJSONArray, empty otherwise)
+KeyNum: The index of the element.
+     (Index in TJSONArray/TJSONObject, 0 otherwise)
+Value : The value of the element
+     (These are the member values for TJSONArray/TJSONObject, and is the
+     element itself otherwise)
+
+While the enumerator is looping, it is not allowed to change the content of
+the array or object, and the value may not be freed.
+
+Scanner/Parser
+==============
+
+The JSONSCanner unit contains a scanner for JSON data: TJSONScanner. 
+Currently it does not support full unicode, only UTF-8 is supported.
+
+The JSONParser unit contains the parser for JSON data: TJSONParser. 
+It uses to scanner to read the tokens. The scanner is created automatically.
+
+
+The Parse method will parse the data that was passed to the parser and will
+return the JSON value.
+
+Sample use:
+
+Var
+  P : TJSONParser;
+  S : String;
+  D : TJSONObject;
+
+begin
+  P:=TJSONParser.Create('{ "top": 10, "left": 20}');
+  try
+    D:=P.Parse as TJSONObject;
+    Writeln('Top : ',D.Integers['top']);
+    Writeln('Left : ',D.Integers['left']);
+    D.free;
+  Finally
+    P.free;
+  end;
+end;
+
+Note that the member names are case sensitive. 
+
+As an alternative, a stream may be passed to the constructor of TJSONParser.
+
+The scanner and parser support the 'Strict' property. 
+Strict JSON syntax requires the member names of an object to be strings:
+{ "top": 10, "left": 20}
+However, due to the sloppy definition of Javascript (and hence JSON), 
+the following type of JSON notation is frequently encountered:
+{ top: 10, left: 20}
+By default, this sloppy notation is accepted. Setting 'Strict' to true will
+reject this.
+
+A second effect of the Strict property is the requirement of " as a string
+delimiter. A single quote is also often found in Javascript and JSON:
+{ title: 'A nice title' }
+By default, this is accepted. Setting 'Strict' to true will reject this.
+
+Customizing the classes : Factory support
+=========================================
+
+The various classes created by the methods can be customized. 
+This can be useful to create customized descendents, for example to attach
+extra data to the various values. All instances of TJSONData are created
+through the CreateJSON() functions, which use a set of customizable classes
+to create the JSONData structures.
+
+All functions which somehow create a new instance (clone, add, insert, parsing)
+use the CreateJSON functions.
+
+Which classes need to be created for a specific value is enumerated in
+
+TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat,
+                       jitString, jitBoolean, jitNull, jitArray, jitObject);
+
+when a Int64 value must be instantiated, the class identified with 
+jitNumberInt64 is instantiated.
+
+To customize the classes, the new class can be set using SetJSONInstanceType:
+
+Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
+Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
+
+The function checks whether sane classes are specified.;

+ 3742 - 0
compiler/packages/fcl-json/src/fpjson.pp

@@ -0,0 +1,3742 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Data structures
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit fpjson;
+
+interface
+
+uses
+  {$ifdef fpc}
+  variants,
+  {$endif}
+  {$ifdef pas2js}
+  JS, RTLConsts, Types,
+  {$endif}
+  SysUtils,
+  classes,
+  contnrs;
+
+type
+  TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
+  TJSONInstanceType = (
+    jitUnknown,
+    jitNumberInteger,
+    {$ifdef fpc}
+    jitNumberInt64,
+    jitNumberQWord,
+    {$endif}
+    jitNumberFloat,
+    jitString,
+    jitBoolean,
+    jitNull,
+    jitArray,
+    jitObject);
+  TJSONFloat = Double;
+  TJSONStringType = {$ifdef fpc}UTF8String{$else}string{$endif};
+  TJSONUnicodeStringType = Unicodestring;
+  {$ifdef fpc}
+  TJSONCharType = AnsiChar;
+  PJSONCharType = ^TJSONCharType;
+  TJSONVariant = variant;
+  TFPJSStream = TMemoryStream;
+  {$else}
+  TJSONCharType = char;
+  TJSONVariant = jsvalue;
+  TFPJSStream = TJSArray;
+  {$endif}
+  TFormatOption = (foSingleLineArray,   // Array without CR/LF : all on one line
+                   foSingleLineObject,  // Object without CR/LF : all on one line
+                   foDoNotQuoteMembers, // Do not quote object member names.
+                   foUseTabchar,        // Use tab characters instead of spaces.
+                   foSkipWhiteSpace,    // Do not use whitespace at all
+                   foSkipWhiteSpaceOnlyLeading   //  When foSkipWhiteSpace is active, skip whitespace for object members only before :
+                   );
+  TFormatOptions = set of TFormatOption;
+
+Const
+  DefaultIndentSize = 2;
+  DefaultFormat     = [];
+  AsJSONFormat      = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
+  AsCompressedJSON  = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True
+  AsCompactJSON     = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace,foDoNotQuoteMembers]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True and TJSONObject.UnquotedMemberNames=True
+  ValueJSONTypes    = [jtNumber, jtString, jtBoolean, jtNull];
+  ActualValueJSONTypes = ValueJSONTypes - [jtNull];
+  StructuredJSONTypes  = [jtArray,jtObject];
+
+Type
+  TJSONData = Class;
+
+  { TBaseJSONEnumerator }
+
+  TJSONEnum = Record
+    Key : TJSONStringType;
+    KeyNum : Integer;
+    Value : TJSONData;
+  end;
+
+  TBaseJSONEnumerator = class
+  public
+    function GetCurrent: TJSONEnum; virtual; abstract;
+    function MoveNext : Boolean; virtual; abstract;
+    property Current: TJSONEnum read GetCurrent;
+  end;
+
+  { TJSONData }
+  
+  TJSONData = class(TObject)
+  private
+    Const
+      ElementSeps  : Array[Boolean] of TJSONStringType = (', ',',');
+    Class Var FCompressedJSON : Boolean;
+    Class Var FElementSep : TJSONStringType;
+    class procedure DetermineElementSeparators;
+    class function GetCompressedJSON: Boolean; {$ifdef fpc}static;{$endif}
+    class procedure SetCompressedJSON(AValue: Boolean); {$ifdef fpc}static;{$endif}
+  protected
+    Class Procedure DoError(Const Msg : String);
+    Class Procedure DoError(Const Fmt : String; const Args : Array of {$ifdef pas2js}jsvalue{$else}Const{$endif});
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
+    function GetAsBoolean: Boolean; virtual; abstract;
+    function GetAsFloat: TJSONFloat; virtual; abstract;
+    function GetAsInteger: Integer; virtual; abstract;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; virtual; abstract;
+    function GetAsQWord: QWord; virtual; abstract;
+    {$endif}
+    function GetIsNull: Boolean; virtual;
+    procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
+    procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
+    procedure SetAsInteger(const AValue: Integer); virtual; abstract;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); virtual; abstract;
+    procedure SetAsQword(const AValue: QWord); virtual; abstract;
+    {$endif}
+    function GetAsJSON: TJSONStringType; virtual; abstract;
+    function GetAsString: TJSONStringType; virtual; abstract;
+    procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
+    {$ifdef fpc}
+    function GetAsUnicodeString: TJSONUnicodeStringType; virtual; 
+    procedure SetAsUnicodeString(const AValue: TJSONUnicodeStringType); virtual;
+    {$endif}
+    function GetValue: TJSONVariant; virtual; abstract;
+    procedure SetValue(const AValue: TJSONVariant); virtual; abstract;
+    function GetItem(Index : Integer): TJSONData; virtual;
+    procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
+    function GetCount: Integer; virtual;
+  Public
+    Class function JSONType: TJSONType; virtual;
+    Class Property CompressedJSON : Boolean Read GetCompressedJSON Write SetCompressedJSON;
+  public
+    Constructor Create; virtual;
+    Procedure Clear;  virtual; Abstract;
+    Procedure DumpJSON(S : TFPJSStream);
+    // Get enumerator
+    function GetEnumerator: TBaseJSONEnumerator; virtual;
+    Function FindPath(Const APath : TJSONStringType) : TJSONdata;
+    Function GetPath(Const APath : TJSONStringType) : TJSONdata;
+    Function Clone : TJSONData; virtual; abstract;
+    Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType; 
+    property Count: Integer read GetCount;
+    property Items[Index: Integer]: TJSONData read GetItem write SetItem;
+    property Value: TJSONVariant read GetValue write SetValue;
+    Property AsString : TJSONStringType Read GetAsString Write SetAsString;
+    {$ifdef fpc}
+    Property AsUnicodeString : TJSONUnicodeStringType Read GetAsUnicodeString Write SetAsUnicodeString;
+    {$endif}
+    Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
+    Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
+    {$ifdef fpc}
+    Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
+    Property AsQWord : QWord Read GetAsQWord Write SetAsQword;
+    {$endif}
+    Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
+    Property IsNull : Boolean Read GetIsNull;
+    Property AsJSON : TJSONStringType Read GetAsJSON;
+  end;
+
+  TJSONDataClass = Class of TJSONData;
+  TJSONNumberType = (
+    ntFloat,
+    ntInteger
+    {$ifdef fpc}
+    ,ntInt64
+    ,ntQWord
+    {$endif}
+    );
+
+  TJSONNumber = class(TJSONData)
+  protected
+  public
+    class function JSONType: TJSONType; override;
+    class function NumberType : TJSONNumberType; virtual; abstract;
+  end;
+
+  { TJSONFloatNumber }
+
+  TJSONFloatNumber = class(TJSONNumber)
+  Private
+    FValue : TJSONFloat;
+  protected
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+  public
+    Constructor Create(AValue : TJSONFloat); reintroduce;
+    class function NumberType : TJSONNumberType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONFloatNumberClass = Class of TJSONFloatNumber;
+
+  { TJSONIntegerNumber }
+
+  TJSONIntegerNumber = class(TJSONNumber)
+  Private
+    FValue : Integer;
+  protected
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+  public
+    Constructor Create(AValue : Integer); reintroduce;
+    class function NumberType : TJSONNumberType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONIntegerNumberClass = Class of TJSONIntegerNumber;
+
+  {$ifdef fpc}
+  { TJSONInt64Number }
+
+  TJSONInt64Number = class(TJSONNumber)
+  Private
+    FValue : Int64;
+  protected
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+  public
+    Constructor Create(AValue : Int64); reintroduce;
+    class function NumberType : TJSONNumberType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONInt64NumberClass = Class of TJSONInt64Number;
+  {$endif}
+
+  {$ifdef fpc}
+  { TJSONQWordNumber }
+
+  TJSONQWordNumber = class(TJSONNumber)
+  Private
+    FValue : Qword;
+  protected
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+  public
+    Constructor Create(AValue : QWord); reintroduce;
+    class function NumberType : TJSONNumberType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONQWordNumberClass = Class of TJSONQWordNumber;
+  {$endif}
+
+  { TJSONString }
+
+  TJSONString = class(TJSONData)
+  Private
+    FValue: TJSONStringType;
+  protected
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+  Public
+    Class var StrictEscaping : Boolean;
+  public
+    Constructor Create(const AValue : TJSONStringType); reintroduce;
+    {$ifdef fpc}
+    Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
+    {$endif}
+    class function JSONType: TJSONType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONStringClass = Class of TJSONString;
+
+  { TJSONBoolean }
+
+  TJSONBoolean = class(TJSONData)
+  Private
+    FValue: Boolean;
+  protected
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+  public
+    Constructor Create(AValue : Boolean); reintroduce;
+    class function JSONType: TJSONType; override;
+    Procedure Clear;  override;
+    Function  Clone : TJSONData; override;
+  end;
+  TJSONBooleanClass = Class of TJSONBoolean;
+
+  { TJSONnull }
+
+  TJSONNull = class(TJSONData)
+  protected
+    Procedure Converterror(From : Boolean);
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    function GetIsNull: Boolean; override;
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+  public
+    class function JSONType: TJSONType; override;
+    Procedure Clear;  override;
+    Function Clone : TJSONData; override;
+  end;
+  TJSONNullClass = Class of TJSONNull;
+
+  TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
+
+  { TJSONArray }
+  TJSONObject = Class;
+
+  TJSONArray = class(TJSONData)
+  Private
+    FList : TFPObjectList;
+    function GetArrays(Index : Integer): TJSONArray;
+    function GetBooleans(Index : Integer): Boolean;
+    function GetFloats(Index : Integer): TJSONFloat;
+    function GetIntegers(Index : Integer): Integer;
+    {$ifdef fpc}
+    function GetInt64s(Index : Integer): Int64;
+    {$endif}
+    function GetNulls(Index : Integer): Boolean;
+    function GetObjects(Index : Integer): TJSONObject;
+    {$ifdef fpc}
+    function GetQWords(Index : Integer): QWord;
+    {$endif}
+    function GetStrings(Index : Integer): TJSONStringType;
+    {$ifdef fpc}
+    function GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
+    {$endif}
+    function GetTypes(Index : Integer): TJSONType;
+    procedure SetArrays(Index : Integer; const AValue: TJSONArray);
+    procedure SetBooleans(Index : Integer; const AValue: Boolean);
+    procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
+    procedure SetIntegers(Index : Integer; const AValue: Integer);
+    {$ifdef fpc}
+    procedure SetInt64s(Index : Integer; const AValue: Int64);
+    {$endif}
+    procedure SetObjects(Index : Integer; const AValue: TJSONObject);
+    {$ifdef fpc}
+    procedure SetQWords(Index : Integer; AValue: QWord);
+    {$endif}
+    procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
+    {$ifdef fpc}
+    procedure SetUnicodeStrings(Index : Integer; const AValue: TJSONUnicodeStringType);
+    {$endif}
+  protected
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
+    Procedure Converterror(From : Boolean);
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+    function GetCount: Integer; override;
+    function GetItem(Index : Integer): TJSONData; override;
+    procedure SetItem(Index : Integer; const AValue: TJSONData); override;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
+  public
+    Constructor Create; overload; reintroduce;
+    Constructor Create(const Elements : Array of {$ifdef pas2js}jsvalue{$else}Const{$endif}); overload;
+    Destructor Destroy; override;
+    class function JSONType: TJSONType; override;
+    Function Clone : TJSONData; override;
+    // Examine
+    procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
+    function IndexOf(obj: TJSONData): Integer;
+    function GetEnumerator: TBaseJSONEnumerator; override;
+    // Manipulate
+    Procedure Clear;  override;
+    function Add(Item : TJSONData): Integer;
+    function Add(I : Integer): Integer;
+    {$ifdef fpc}
+    function Add(I : Int64): Int64;
+    function Add(I : QWord): QWord;
+    {$endif}
+    function Add(const S : String): Integer;
+    {$ifdef fpc}
+    function Add(const S : UnicodeString): Integer;
+    {$endif}
+    function Add: Integer;
+    function Add(F : TJSONFloat): Integer;
+    function Add(B : Boolean): Integer;
+    function Add(AnArray : TJSONArray): Integer;
+    function Add(AnObject: TJSONObject): Integer;
+    Procedure Delete(Index : Integer);
+    procedure Exchange(Index1, Index2: Integer);
+    function Extract(Item: TJSONData): TJSONData;
+    function Extract(Index : Integer): TJSONData;
+    procedure Insert(Index: Integer);
+    procedure Insert(Index: Integer; Item : TJSONData);
+    procedure Insert(Index: Integer; I : Integer);
+    {$ifdef fpc}
+    procedure Insert(Index: Integer; I : Int64);
+    procedure Insert(Index: Integer; I : QWord);
+    {$endif}
+    procedure Insert(Index: Integer; const S : String);
+    {$ifdef fpc}
+    procedure Insert(Index: Integer; const S : UnicodeString);
+    {$endif}
+    procedure Insert(Index: Integer; F : TJSONFloat);
+    procedure Insert(Index: Integer; B : Boolean);
+    procedure Insert(Index: Integer; AnArray : TJSONArray);
+    procedure Insert(Index: Integer; AnObject: TJSONObject);
+    procedure Move(CurIndex, NewIndex: Integer);
+    Procedure Remove(Item : TJSONData);
+    Procedure Sort(Compare: TListSortCompare);
+    // Easy Access Properties.
+    property Items;default;
+    Property Types[Index : Integer] : TJSONType Read GetTypes;
+    Property Nulls[Index : Integer] : Boolean Read GetNulls;
+    Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
+    {$ifdef fpc}
+    Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
+    Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
+    {$endif}
+    Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
+    {$ifdef fpc}
+    Property UnicodeStrings[Index : Integer] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
+    {$endif}
+    Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
+    Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
+    Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
+    Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
+  end;
+  TJSONArrayClass = Class of TJSONArray;
+
+  TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
+
+  { TJSONObject }
+
+  TJSONObject = class(TJSONData)
+  private
+    Const
+      ElementStart   : Array[Boolean] of TJSONStringType = ('"','');
+      SpacedQuoted   : Array[Boolean] of TJSONStringType = ('" : ',' : ');
+      UnSpacedQuoted : Array[Boolean] of TJSONStringType = ('":',':');
+      ObjStartSeps   : Array[Boolean] of TJSONStringType = ('{ ','{');
+      ObjEndSeps     : Array[Boolean] of TJSONStringType = (' }','}');
+    Class var FUnquotedMemberNames: Boolean;
+    Class var FObjStartSep,FObjEndSep,FElementEnd,FElementStart : TJSONStringType;
+    function DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError: Boolean=True): Integer;
+    Class procedure DetermineElementQuotes;
+  Private
+    {$ifdef pas2js}
+    FCount: integer;
+    FHash: TJSObject;
+    FNames: TStringDynArray;
+    {$else}
+    FHash : TFPHashObjectList; // Careful : Names limited to 255 chars.
+    {$endif}
+    function GetArrays(const AName : String): TJSONArray;
+    function GetBooleans(const AName : String): Boolean;
+    function GetElements(const AName: string): TJSONData;
+    function GetFloats(const AName : String): TJSONFloat;
+    function GetIntegers(const AName : String): Integer;
+    {$ifdef fpc}
+    function GetInt64s(const AName : String): Int64;
+    {$endif}
+    function GetIsNull(const AName : String): Boolean; reintroduce;
+    function GetNameOf(Index : Integer): TJSONStringType;
+    function GetObjects(const AName : String): TJSONObject;
+    {$ifdef fpc}
+    function GetQWords(AName : String): QWord;
+    {$endif}
+    function GetStrings(const AName : String): TJSONStringType;
+    {$ifdef fpc}
+    function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
+    {$endif}
+    function GetTypes(const AName : String): TJSONType;
+    procedure SetArrays(const AName : String; const AValue: TJSONArray);
+    procedure SetBooleans(const AName : String; const AValue: Boolean);
+    procedure SetElements(const AName: string; const AValue: TJSONData);
+    procedure SetFloats(const AName : String; const AValue: TJSONFloat);
+    procedure SetIntegers(const AName : String; const AValue: Integer);
+    {$ifdef fpc}
+    procedure SetInt64s(const AName : String; const AValue: Int64);
+    {$endif}
+    procedure SetIsNull(const AName : String; const AValue: Boolean);
+    procedure SetObjects(const AName : String; const AValue: TJSONObject);
+    {$ifdef fpc}
+    procedure SetQWords(AName : String; AValue: QWord);
+    {$endif}
+    procedure SetStrings(const AName : String; const AValue: TJSONStringType);
+    {$ifdef fpc}
+    procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
+    {$endif}
+    class function GetUnquotedMemberNames: Boolean; {$ifdef fpc}static;{$endif}
+    class procedure SetUnquotedMemberNames(AValue: Boolean); {$ifdef fpc}static;{$endif}
+  protected
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
+    Procedure Converterror(From : Boolean);
+    function GetAsBoolean: Boolean; override;
+    function GetAsFloat: TJSONFloat; override;
+    function GetAsInteger: Integer; override;
+    {$ifdef fpc}
+    function GetAsInt64: Int64; override;
+    function GetAsQWord: QWord; override;
+    {$endif}
+    procedure SetAsBoolean(const AValue: Boolean); override;
+    procedure SetAsFloat(const AValue: TJSONFloat); override;
+    procedure SetAsInteger(const AValue: Integer); override;
+    {$ifdef fpc}
+    procedure SetAsInt64(const AValue: Int64); override;
+    procedure SetAsQword(const AValue: QWord); override;
+    {$endif}
+    function GetAsJSON: TJSONStringType; override;
+    function GetAsString: TJSONStringType; override;
+    procedure SetAsString(const AValue: TJSONStringType); override;
+    function GetValue: TJSONVariant; override;
+    procedure SetValue(const AValue: TJSONVariant); override;
+    function GetCount: Integer; override;
+    function GetItem(Index : Integer): TJSONData; override;
+    procedure SetItem(Index : Integer; const AValue: TJSONData); override;
+    Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
+  public
+    constructor Create; reintroduce;
+    Constructor Create(const Elements : Array of {$ifdef pas2js}jsvalue{$else}Const{$endif}); overload;
+    destructor Destroy; override;
+    class function JSONType: TJSONType; override;
+    Class Property UnquotedMemberNames : Boolean Read GetUnquotedMemberNames Write SetUnquotedMemberNames;
+    Function Clone : TJSONData; override;
+    function GetEnumerator: TBaseJSONEnumerator; override;
+    // Examine
+    procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
+    function IndexOf(Item: TJSONData): Integer;
+    Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
+    Function Find(Const AName : String) : TJSONData; overload;
+    Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
+    function Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
+    Function Get(Const AName : String) : TJSONVariant;
+    Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
+    Function Get(Const AName : String; ADefault : Integer) : Integer;
+    {$ifdef fpc}
+    Function Get(Const AName : String; ADefault : Int64) : Int64;
+    Function Get(Const AName : String; ADefault : QWord) : QWord;
+    {$endif}
+    Function Get(Const AName : String; ADefault : Boolean) : Boolean;
+    Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringType;
+    {$ifdef fpc}
+    Function Get(Const AName : String; ADefault : TJSONUnicodeStringType) : TJSONUnicodeStringType;
+    {$endif}
+    Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
+    Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
+    // Manipulate
+    Procedure Clear;  override;
+    function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
+    function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
+    function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
+    function Add(const AName, AValue: TJSONStringType): Integer; overload;
+    {$ifdef fpc}
+    function Add(const AName : String; AValue: TJSONUnicodeStringType): Integer; overload;
+    {$endif}
+    function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
+    {$ifdef fpc}
+    function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
+    function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
+    {$endif}
+    function Add(const AName: TJSONStringType): Integer; overload;
+    function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
+    procedure Delete(Index : Integer);
+    procedure Delete(Const AName : string);
+    procedure Remove(Item : TJSONData);
+    {$ifdef fpc}
+    Function Extract(Index : Integer) : TJSONData;
+    Function Extract(Const AName : string) : TJSONData;
+    {$endif}
+
+    // Easy access properties.
+    property Names[Index : Integer] : TJSONStringType read GetNameOf;
+    property Elements[AName: string] : TJSONData read GetElements write SetElements; default;
+
+    Property Types[AName : String] : TJSONType Read GetTypes;
+    Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
+    Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
+    Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
+    {$ifdef fpc}
+    Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
+    Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
+    {$endif}
+    Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
+    {$ifdef fpc}
+    Property UnicodeStrings[AName : String] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
+    {$endif}
+    Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
+    Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
+    Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
+  end;
+  TJSONObjectClass = Class of TJSONObject;
+
+  EJSON = Class(Exception);
+
+  {$ifdef fpc}
+  TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
+  {$endif}
+
+Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
+Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
+
+Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
+Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
+Function JSONTypeName(JSONType : TJSONType) : String;
+
+// These functions create JSONData structures, taking into account the instance types
+Function CreateJSON : TJSONNull;
+Function CreateJSON(Data : Boolean) : TJSONBoolean;
+Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
+{$ifdef fpc}
+Function CreateJSON(Data : Int64) : TJSONInt64Number;
+Function CreateJSON(Data : QWord) : TJSONQWordNumber;
+{$endif}
+Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
+Function CreateJSON(const Data : TJSONStringType) : TJSONString;
+{$ifdef fpc}
+Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
+{$endif}
+Function CreateJSONArray(const Data : Array of {$ifdef pas2js}jsvalue{$else}Const{$endif}) : TJSONArray;
+Function CreateJSONObject(const Data : Array of {$ifdef pas2js}jsvalue{$else}Const{$endif}) : TJSONObject;
+
+// These functions rely on a callback. If the callback is not set, they will raise an error.
+// When the jsonparser unit is included in the project, the callback is automatically set.
+{$ifdef fpc}
+Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
+Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
+Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
+Function GetJSONParserHandler : TJSONParserHandler;
+{$endif}
+
+implementation
+
+Uses typinfo;
+
+Resourcestring
+  SErrCannotConvertFromNull = 'Cannot convert data from Null value';
+  SErrCannotConvertToNull = 'Cannot convert data to Null value';
+  SErrCannotConvertFromArray = 'Cannot convert data from array value';
+  SErrCannotConvertToArray = 'Cannot convert data to array value';
+  SErrCannotConvertFromObject = 'Cannot convert data from object value';
+  SErrCannotConvertToObject = 'Cannot convert data to object value';
+  SErrInvalidFloat = 'Invalid float value : %s';
+  SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
+  SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
+  SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
+  SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d';
+  SErrNotJSONData = 'Cannot add object of type %s to TJSON%s';
+  SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
+  SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
+  SErrNonexistentElement = 'Unknown object member: "%s"';
+  SErrDuplicateValue = 'Duplicate object member: "%s"';
+  SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
+  SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.';
+  {$ifdef fpc}
+  SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
+  SErrNoParserHandler = 'No JSON parser handler installed. Recompile your project with the jsonparser unit included';
+  {$endif}
+
+Var
+  DefaultJSONInstanceTypes :
+    Array [TJSONInstanceType] of TJSONDataClass = (
+      TJSONData,
+      TJSONIntegerNumber,
+      {$ifdef fpc}
+      TJSONInt64Number,
+      TJSONQWordNumber,
+      {$endif}
+      TJSONFloatNumber,
+      TJSONString,
+      TJSONBoolean,
+      TJSONNull,
+      TJSONArray,
+      TJSONObject);
+Const
+  MinJSONInstanceTypes :
+    Array [TJSONInstanceType] of TJSONDataClass = (
+      TJSONData,
+      TJSONIntegerNumber,
+      {$ifdef fpc}
+      TJSONInt64Number,
+      TJSONQWordNumber,
+      {$endif}
+      TJSONFloatNumber,
+      TJSONString,
+      TJSONBoolean,
+      TJSONNull,
+      TJSONArray,
+      TJSONObject
+      );
+
+function SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass): TJSONDataClass;
+begin
+  if AClass=Nil then
+    TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONInstanceTypes[AType].ClassName]);
+  if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
+    TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONInstanceTypes[AType].ClassName]);
+  Result:=DefaultJSONInstanceTypes[AType];
+  DefaultJSONINstanceTypes[AType]:=AClass;
+end;
+
+function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass;
+begin
+  Result:=DefaultJSONInstanceTypes[AType]
+end;
+
+function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
+
+Var
+  I,J,L : Integer;
+  C : Char;
+
+begin
+  I:=1;
+  J:=1;
+  Result:='';
+  L:=Length(S);
+  While I<=L do
+    begin
+    C:=S[I];
+    if (C in ['"','/','\',#0..#31]) then
+      begin
+      Result:=Result+Copy(S,J,I-J);
+      Case C of
+        '\' : Result:=Result+'\\';
+        '/' : if Strict then
+                Result:=Result+'\/'
+              else
+                Result:=Result+'/';
+        '"' : Result:=Result+'\"';
+        #8  : Result:=Result+'\b';
+        #9  : Result:=Result+'\t';
+        #10 : Result:=Result+'\n';
+        #12 : Result:=Result+'\f';
+        #13 : Result:=Result+'\r';
+      else
+        Result:=Result+'\u'+HexStr(Ord(C),4);
+      end;
+      J:=I+1;
+      end;
+    Inc(I);
+    end;
+  Result:=Result+Copy(S,J,I-1);
+end;
+
+function JSONStringToString(const S: TJSONStringType): TJSONStringType;
+
+Var
+  I,J,L,U1,U2 : Integer;
+  App,W : String;
+
+  Procedure MaybeAppendUnicode;
+
+  Var
+    U : String;
+
+  begin
+    if (U1<>0) then
+      begin
+      U:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode(WideChar(U1)){$ELSE}widechar(U1){$ENDIF};
+      Result:=Result+U;
+      U1:=0;
+      end;
+  end;
+
+begin
+  I:=1;
+  J:=1;
+  L:=Length(S);
+  Result:='';
+  U1:=0;
+  While (I<=L) do
+    begin
+    if (S[I]='\') then
+      begin
+      Result:=Result+Copy(S,J,I-J);
+      If I<L then
+        begin
+        Inc(I);
+        App:='';
+        Case S[I] of
+          '\','"','/'
+              : App:=S[I];
+          'b' : App:=#8;
+          't' : App:=#9;
+          'n' : App:=#10;
+          'f' : App:=#12;
+          'r' : App:=#13;
+          'u' : begin
+                W:=Copy(S,I+1,4);
+                Inc(I,4);
+                u2:=StrToInt('$'+W);
+                if (U1<>0) then
+                  begin
+                  App:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode({$ENDIF}WideChar(U1)+WideChar(U2){$IFDEF FPC_HAS_CPSTRING}){$ENDIF};
+                  U2:=0;
+                  end
+                else
+                  U1:=U2;
+                end;
+        end;
+        if App<>'' then
+          begin
+          MaybeAppendUnicode;
+          Result:=Result+App;
+          end;
+        end;
+      J:=I+1;
+      end
+    else
+      MaybeAppendUnicode;
+    Inc(I);
+    end;
+  MaybeAppendUnicode;
+  Result:=Result+Copy(S,J,I-J+1);
+end;
+
+function JSONTypeName(JSONType: TJSONType): String;
+begin
+  Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
+end;
+
+function CreateJSON: TJSONNull;
+begin
+  Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create
+end;
+
+function CreateJSON(Data: Boolean): TJSONBoolean;
+begin
+  Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data);
+end;
+
+function CreateJSON(Data: Integer): TJSONIntegerNumber;
+begin
+  Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data);
+end;
+
+{$ifdef fpc}
+function CreateJSON(Data: Int64): TJSONInt64Number;
+begin
+  Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data);
+end;
+
+function CreateJSON(Data: QWord): TJSONQWordNumber;
+begin
+  Result:=TJSONQWordNumberClass(DefaultJSONInstanceTypes[jitNumberQWord]).Create(Data);
+end;
+{$endif}
+
+function CreateJSON(Data: TJSONFloat): TJSONFloatNumber;
+begin
+  Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
+end;
+
+function CreateJSON(const Data: TJSONStringType): TJSONString;
+begin
+  Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
+end;
+
+{$ifdef fpc}
+function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
+begin
+  Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
+end;
+{$endif}
+
+function CreateJSONArray(const Data: array of {$ifdef pas2js}jsvalue{$else}Const{$endif}): TJSONArray;
+begin
+  Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
+end;
+
+function CreateJSONObject(const Data: array of {$ifdef pas2js}jsvalue{$else}Const{$endif}): TJSONObject;
+begin
+  Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
+end;
+
+{$ifdef fpc}
+function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
+
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create(JSON);
+  try
+    Result:=GetJSON(SS,UseUTF8);
+  finally
+    SS.Free;
+  end;
+end;
+{$endif}
+
+{$ifdef fpc}
+Var
+  JPH : TJSONParserHandler;
+
+function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
+
+begin
+  Result:=Nil;
+  If (JPH=Nil) then
+    TJSONData.DoError(SErrNoParserHandler);
+  JPH(JSON,UseUTF8,Result);
+end;
+
+function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
+begin
+  Result:=JPH;
+  JPH:=AHandler;
+end;
+
+function GetJSONParserHandler: TJSONParserHandler;
+begin
+  Result:=JPH;
+end;
+{$endif}
+
+Type
+  { TJSONEnumerator }
+
+  TJSONEnumerator = class(TBaseJSONEnumerator)
+  Private
+    FData : TJSONData;
+  public
+    Constructor Create(AData : TJSONData);
+    function GetCurrent: TJSONEnum; override;
+    function MoveNext : Boolean; override;
+  end;
+
+  { TJSONArrayEnumerator }
+
+  TJSONArrayEnumerator = class(TBaseJSONEnumerator)
+  Private
+    FData : TJSONArray;
+    FCurrent : Integer;
+  public
+    Constructor Create(AData : TJSONArray);
+    function GetCurrent: TJSONEnum; override;
+    function MoveNext : Boolean; override;
+  end;
+
+  { TJSONObjectEnumerator }
+
+  TJSONObjectEnumerator = class(TBaseJSONEnumerator)
+  Private
+    FData : TJSONObject;
+    FCurrent : Integer;
+  public
+    Constructor Create(AData : TJSONObject);
+    function GetCurrent: TJSONEnum; override;
+    function MoveNext : Boolean; override;
+  end;
+
+{$ifdef fpc}
+{ TJSONQWordNumber }
+
+function TJSONQWordNumber.GetAsBoolean: Boolean;
+begin
+  Result:=FValue<>0;
+end;
+
+function TJSONQWordNumber.GetAsFloat: TJSONFloat;
+begin
+  Result:= FValue;
+end;
+
+function TJSONQWordNumber.GetAsInteger: Integer;
+begin
+  Result := FValue;
+end;
+
+function TJSONQWordNumber.GetAsInt64: Int64;
+begin
+  Result := FValue;
+end;
+
+function TJSONQWordNumber.GetAsQWord: QWord;
+begin
+  Result := FValue;
+end;
+
+procedure TJSONQWordNumber.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=Ord(AValue);
+end;
+
+procedure TJSONQWordNumber.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=Round(AValue);
+end;
+
+procedure TJSONQWordNumber.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=AValue;
+end;
+
+procedure TJSONQWordNumber.SetAsInt64(const AValue: Int64);
+begin
+  FValue := AValue;
+end;
+
+procedure TJSONQWordNumber.SetAsQword(const AValue: QWord);
+begin
+  FValue:=AValue;
+end;
+
+function TJSONQWordNumber.GetAsJSON: TJSONStringType;
+begin
+  Result:=AsString;
+end;
+
+function TJSONQWordNumber.GetAsString: TJSONStringType;
+begin
+  Result:=IntToStr(FValue);
+end;
+
+procedure TJSONQWordNumber.SetAsString(const AValue: TJSONStringType);
+begin
+  FValue:=StrToQWord(AValue);
+end;
+
+function TJSONQWordNumber.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONQWordNumber.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:=AValue;
+end;
+
+constructor TJSONQWordNumber.Create(AValue: QWord);
+begin
+  FValue := AValue;
+end;
+
+class function TJSONQWordNumber.NumberType: TJSONNumberType;
+begin
+  Result:=ntQWord;
+end;
+
+procedure TJSONQWordNumber.Clear;
+begin
+  FValue:=0;
+end;
+
+function TJSONQWordNumber.Clone: TJSONData;
+begin
+  Result:=TJSONQWordNumberClass(ClassType).Create(Self.FValue);
+end;
+{$endif}
+
+{ TJSONObjectEnumerator }
+
+constructor TJSONObjectEnumerator.Create(AData: TJSONObject);
+begin
+  FData:=AData;
+  FCurrent:=-1;
+end;
+
+function TJSONObjectEnumerator.GetCurrent: TJSONEnum;
+begin
+  Result.KeyNum:=FCurrent;
+  Result.Key:=FData.Names[FCurrent];
+  Result.Value:=FData.Items[FCurrent];
+end;
+
+function TJSONObjectEnumerator.MoveNext: Boolean;
+begin
+  Inc(FCurrent);
+  Result:=FCurrent<FData.Count;
+end;
+
+{ TJSONArrayEnumerator }
+
+constructor TJSONArrayEnumerator.Create(AData: TJSONArray);
+begin
+  FData:=AData;
+  FCurrent:=-1;
+end;
+
+function TJSONArrayEnumerator.GetCurrent: TJSONEnum;
+begin
+  Result.KeyNum:=FCurrent;
+  Result.Key:=IntToStr(FCurrent);
+  Result.Value:=FData.Items[FCurrent];
+end;
+
+function TJSONArrayEnumerator.MoveNext: Boolean;
+begin
+  Inc(FCurrent);
+  Result:=FCurrent<FData.Count;
+end;
+
+  { TJSONEnumerator }
+
+constructor TJSONEnumerator.Create(AData: TJSONData);
+begin
+  FData:=AData;
+end;
+
+function TJSONEnumerator.GetCurrent: TJSONEnum;
+begin
+  Result.Key:='';
+  Result.KeyNum:=0;
+  Result.Value:=FData;
+  FData:=Nil;
+end;
+
+function TJSONEnumerator.MoveNext: Boolean;
+begin
+  Result:=FData<>Nil;
+end;
+
+
+
+{ TJSONData }
+
+{$ifdef fpc}
+function TJSONData.GetAsUnicodeString: TJSONUnicodeStringType; 
+begin
+  Result:=UTF8Decode(AsString);
+end;
+
+procedure TJSONData.SetAsUnicodeString(const AValue: TJSONUnicodeStringType); 
+begin
+  AsString:=UTF8Encode(AValue);
+end;
+{$endif}
+
+function TJSONData.GetItem(Index : Integer): TJSONData;
+begin
+  Result:=nil;
+  if Index>0 then ;
+end;
+
+function TJSONData.GetCount: Integer;
+begin
+  Result:=0;
+end;
+
+constructor TJSONData.Create;
+begin
+  Clear;
+end;
+
+procedure TJSONData.DumpJSON(S: TFPJSStream);
+
+  Procedure W(T : String);
+  begin
+    if T='' then exit;
+    {$ifdef pas2js}
+    S.push(T);
+    {$else}
+    S.WriteBuffer(T[1],Length(T)*SizeOf(Char));
+    {$endif}
+  end;
+
+Var
+  I: Integer;
+  O : TJSONObject;
+
+begin
+  Case JSONType of
+    jtObject :
+      begin
+      O:=TJSONObject(Self);
+      W('{');
+      For I:=0 to O.Count-1 do
+        begin
+        if (I>0) then
+          W(',');
+        W('"');
+        W(StringToJSONString(O.Names[i],False));
+        W('":');
+        O.Items[I].DumpJSON(S);
+        end;
+      W('}');
+      end;
+    jtArray :
+      begin
+      W('[');
+      For I:=0 to Count-1 do
+        begin
+        if (I>0) then
+          W(',');
+        Items[I].DumpJSON(S);
+        end;
+      W(']');
+      end
+  else
+    W(AsJSON)
+  end;
+end;
+
+class function TJSONData.GetCompressedJSON: Boolean; {$ifdef fpc}static;{$endif}
+begin
+  Result:=FCompressedJSON;
+end;
+
+class procedure TJSONData.DetermineElementSeparators;
+
+
+begin
+  FElementSep:=ElementSeps[FCompressedJSON];
+end;
+
+class procedure TJSONData.SetCompressedJSON(AValue: Boolean); {$ifdef fpc}static;{$endif}
+
+
+begin
+  if AValue=FCompressedJSON then exit;
+  FCompressedJSON:=AValue;
+  DetermineElementSeparators;
+  TJSONObject.DetermineElementQuotes;
+end;
+
+class procedure TJSONData.DoError(const Msg: String);
+begin
+  Raise EJSON.Create(Msg);
+end;
+
+class procedure TJSONData.DoError(const Fmt: String;
+  const Args: array of {$ifdef pas2js}jsvalue{$else}Const{$endif});
+begin
+  Raise EJSON.CreateFmt(Fmt,Args);
+end;
+
+function TJSONData.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+begin
+  If APath<>'' then
+    begin
+    NotFound:=APath;
+    Result:=Nil;
+    end
+  else
+    Result:=Self;
+end;
+
+function TJSONData.GetIsNull: Boolean;
+begin
+  Result:=False;
+end;
+
+class function TJSONData.JSONType: TJSONType;
+begin
+  JSONType:=jtUnknown;
+end;
+
+function TJSONData.GetEnumerator: TBaseJSONEnumerator;
+begin
+  Result:=TJSONEnumerator.Create(Self);
+end;
+
+function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
+
+Var
+  M : TJSONStringType;
+
+begin
+  Result:=DoFindPath(APath,M);
+end;
+
+function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
+
+Var
+  M : TJSONStringType;
+begin
+  Result:=DoFindPath(APath,M);
+  If Result=Nil then
+    DoError(SErrPathElementNotFound,[APath,M]);
+end;
+
+procedure TJSONData.SetItem(Index : Integer; const AValue:
+  TJSONData);
+begin
+  // Do Nothing
+  if Index>0 then ;
+  if AValue<>nil then ;
+end;
+
+function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer
+  ): TJSONStringType;
+
+begin
+  Result:=DoFormatJSON(Options,0,IndentSize);
+end;
+
+function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
+
+begin
+  Result:=AsJSON;
+  if Options=[] then ;
+  if CurrentIndent=0 then ;
+  if Indent>0 then ;
+end;
+
+{ TJSONnumber }
+
+class function TJSONnumber.JSONType: TJSONType;
+begin
+  Result:=jtNumber;
+end;
+
+
+{ TJSONstring }
+
+class function TJSONString.JSONType: TJSONType;
+begin
+  Result:=jtString;
+end;
+
+procedure TJSONString.Clear;
+begin
+  FValue:='';
+end;
+
+function TJSONString.Clone: TJSONData;
+
+begin
+  Result:=TJSONStringClass(ClassType).Create(Self.FValue);
+end;
+
+function TJSONString.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONString.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:={$ifdef pas2js}TJSONStringType(AValue){$else}AValue{$endif};
+end;
+
+
+function TJSONString.GetAsBoolean: Boolean;
+begin
+  Result:=StrToBool(FValue);
+end;
+
+function TJSONString.GetAsFloat: TJSONFloat;
+
+Var
+  C : Integer;
+
+begin
+  Val(FValue,Result,C);
+  If (C<>0) then
+    If Not TryStrToFloat(FValue,Result) then
+      Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]);
+end;
+
+function TJSONString.GetAsInteger: Integer;
+begin
+  Result:=StrToInt(FValue);
+end;
+
+{$ifdef fpc}
+function TJSONString.GetAsInt64: Int64;
+begin
+  Result:=StrToInt64(FValue);
+end;
+
+function TJSONString.GetAsQWord: QWord;
+begin
+  Result:=StrToQWord(FValue);
+end;
+{$endif}
+
+procedure TJSONString.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=BoolToStr(AValue);
+end;
+
+procedure TJSONString.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=FloatToStr(AValue);
+end;
+
+procedure TJSONString.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=IntToStr(AValue);
+end;
+
+{$ifdef fpc}
+procedure TJSONString.SetAsInt64(const AValue: Int64);
+begin
+  FValue:=IntToStr(AValue);
+end;
+
+procedure TJSONString.SetAsQword(const AValue: QWord);
+begin
+  FValue:=IntToStr(AValue);
+end;
+{$endif}
+
+function TJSONString.GetAsJSON: TJSONStringType;
+begin
+  Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
+end;
+
+function TJSONString.GetAsString: TJSONStringType;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONString.SetAsString(const AValue: TJSONStringType);
+begin
+  FValue:=AValue;
+end;
+
+constructor TJSONString.Create(const AValue: TJSONStringType);
+begin
+  FValue:=AValue;
+end;
+
+{$ifdef fpc}
+constructor TJSONString.Create(const AValue: TJSONUnicodeStringType);
+begin
+  FValue:=UTF8Encode(AValue);
+end;
+{$endif}
+
+{ TJSONboolean }
+
+
+function TJSONBoolean.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+class function TJSONBoolean.JSONType: TJSONType;
+begin
+  Result:=jtBoolean;
+end;
+
+procedure TJSONBoolean.Clear;
+begin
+  FValue:=False;
+end;
+
+function TJSONBoolean.Clone: TJSONData;
+begin
+  Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue);
+end;
+
+
+procedure TJSONBoolean.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:=boolean(AValue);
+end;
+
+function TJSONBoolean.GetAsBoolean: Boolean;
+begin
+  Result:=FValue;
+end;
+
+function TJSONBoolean.GetAsFloat: TJSONFloat;
+begin
+  Result:=Ord(FValue);
+end;
+
+function TJSONBoolean.GetAsInteger: Integer;
+begin
+  Result:=Ord(FValue);
+end;
+
+{$ifdef fpc}
+function TJSONBoolean.GetAsInt64: Int64;
+begin
+  Result:=Ord(FValue);
+end;
+
+function TJSONBoolean.GetAsQWord: QWord;
+begin
+  Result:=Ord(FValue);
+end;
+{$endif}
+
+procedure TJSONBoolean.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=AValue;
+end;
+
+procedure TJSONBoolean.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=(AValue<>0)
+end;
+
+procedure TJSONBoolean.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=(AValue<>0)
+end;
+
+{$ifdef fpc}
+procedure TJSONBoolean.SetAsInt64(const AValue: Int64);
+begin
+  FValue:=(AValue<>0)
+end;
+
+procedure TJSONBoolean.SetAsQword(const AValue: QWord);
+begin
+  FValue:=(AValue<>0)
+end;
+{$endif}
+
+function TJSONBoolean.GetAsJSON: TJSONStringType;
+begin
+  If FValue then
+    Result:='true'
+  else
+    Result:='false';
+end;
+
+function TJSONBoolean.GetAsString: TJSONStringType;
+begin
+  Result:=BoolToStr(FValue, True);
+end;
+
+procedure TJSONBoolean.SetAsString(const AValue: TJSONStringType);
+begin
+  FValue:=StrToBool(AValue);
+end;
+
+
+constructor TJSONBoolean.Create(AValue: Boolean);
+begin
+  FValue:=AValue;
+end;
+
+{ TJSONnull }
+
+procedure TJSONNull.Converterror(From: Boolean);
+begin
+  If From then
+    DoError(SErrCannotConvertFromNull)
+  else
+    DoError(SErrCannotConvertToNull);
+end;
+
+{$warnings off}
+function TJSONNull.GetAsBoolean: Boolean;
+begin
+  ConvertError(True);
+  Result:=false;
+end;
+
+function TJSONNull.GetAsFloat: TJSONFloat;
+begin
+  ConvertError(True);
+  Result:=0.0;
+end;
+
+function TJSONNull.GetAsInteger: Integer;
+begin
+  ConvertError(True);
+  Result:=0;
+end;
+
+{$ifdef fpc}
+function TJSONNull.GetAsInt64: Int64;
+begin
+  ConvertError(True);
+end;
+
+function TJSONNull.GetAsQWord: QWord;
+begin
+  ConvertError(True);
+end;
+{$endif}
+
+function TJSONNull.GetIsNull: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TJSONNull.SetAsBoolean(const AValue: Boolean);
+begin
+  ConvertError(False);
+  if AValue then ;
+end;
+
+procedure TJSONNull.SetAsFloat(const AValue: TJSONFloat);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONNull.SetAsInteger(const AValue: Integer);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+{$ifdef fpc}
+procedure TJSONNull.SetAsInt64(const AValue: Int64);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONNull.SetAsQword(const AValue: QWord);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+{$endif}
+
+function TJSONNull.GetAsJSON: TJSONStringType;
+begin
+  Result:='null';
+end;
+
+function TJSONNull.GetAsString: TJSONStringType;
+begin
+  ConvertError(True);
+  Result:='';
+end;
+
+procedure TJSONNull.SetAsString(const AValue: TJSONStringType);
+begin
+  ConvertError(True);
+  if AValue='' then ;
+end;
+
+
+function TJSONNull.GetValue: TJSONVariant;
+begin
+  Result:={$ifdef pas2js}js.Null{$else}variants.Null{$endif};
+end;
+
+procedure TJSONNull.SetValue(const AValue: TJSONVariant);
+begin
+  ConvertError(False);
+  {$ifdef pas2js}
+  if AValue=0 then ;
+  {$else}
+  if VarType(AValue)=0 then ;
+  {$endif}
+end;
+
+class function TJSONNull.JSONType: TJSONType;
+begin
+  Result:=jtNull;
+end;
+
+procedure TJSONNull.Clear;
+begin
+  // Do nothing
+end;
+
+function TJSONNull.Clone: TJSONData;
+begin
+  Result:=TJSONNullClass(Self.ClassType).Create;
+end;
+
+{$warnings on}
+
+
+
+{ TJSONFloatNumber }
+
+function TJSONFloatNumber.GetAsBoolean: Boolean;
+begin
+  Result:=(FValue<>0);
+end;
+
+function TJSONFloatNumber.GetAsFloat: TJSONFloat;
+begin
+  Result:=FValue;
+end;
+
+function TJSONFloatNumber.GetAsInteger: Integer;
+begin
+  Result:=Round(FValue);
+end;
+
+{$ifdef fpc}
+function TJSONFloatNumber.GetAsInt64: Int64;
+begin
+  Result:=Round(FValue);
+end;
+
+function TJSONFloatNumber.GetAsQWord: QWord;
+begin
+  Result:=Round(FValue);
+end;
+{$endif}
+
+procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=Ord(AValue);
+end;
+
+procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=AValue;
+end;
+
+procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=AValue;
+end;
+
+{$ifdef fpc}
+procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
+begin
+  FValue:=AValue;
+end;
+
+procedure TJSONFloatNumber.SetAsQword(const AValue: QWord);
+begin
+  FValue:=AValue;
+end;
+{$endif}
+
+function TJSONFloatNumber.GetAsJSON: TJSONStringType;
+begin
+  Result:=AsString;
+end;
+
+function TJSONFloatNumber.GetAsString: TJSONStringType;
+begin
+  Str(FValue,Result);
+  // Str produces a ' ' in front where the - can go.
+  if (Result<>'') and (Result[1]=' ') then
+    Delete(Result,1,1);
+end;
+
+procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
+Var
+  C : Integer;
+begin
+  Val(AValue,FValue,C);
+  If (C<>0) then
+    Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
+end;
+
+
+function TJSONFloatNumber.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONFloatNumber.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:={$ifdef pas2js}TJSONFloat(AValue){$else}AValue{$endif};
+end;
+
+constructor TJSONFloatNumber.Create(AValue: TJSONFloat);
+begin
+  FValue:=AValue;
+end;
+
+class function TJSONFloatNumber.NumberType: TJSONNumberType;
+begin
+  Result:=ntFloat;
+end;
+
+procedure TJSONFloatNumber.Clear;
+begin
+  FValue:=0;
+end;
+
+function TJSONFloatNumber.Clone: TJSONData;
+
+begin
+  Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue);
+end;
+
+{ TJSONIntegerNumber }
+
+function TJSONIntegerNumber.GetAsBoolean: Boolean;
+begin
+  Result:=FValue<>0;
+end;
+
+function TJSONIntegerNumber.GetAsFloat: TJSONFloat;
+begin
+  Result:=FValue;
+end;
+
+function TJSONIntegerNumber.GetAsInteger: Integer;
+begin
+  Result:=FValue;
+end;
+
+{$ifdef fpc}
+function TJSONIntegerNumber.GetAsInt64: Int64;
+begin
+  Result:=FValue;
+end;
+
+function TJSONIntegerNumber.GetAsQWord: QWord;
+begin
+  result:=FValue;
+end;
+{$endif}
+
+procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=Ord(AValue);
+end;
+
+procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=Round(AValue);
+end;
+
+procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=AValue;
+end;
+
+{$ifdef fpc}
+procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
+begin
+  FValue:=AValue;
+end;
+
+procedure TJSONIntegerNumber.SetAsQword(const AValue: QWord);
+begin
+  FValue:=AValue;
+end;
+{$endif}
+
+function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
+begin
+  Result:=AsString;
+end;
+
+function TJSONIntegerNumber.GetAsString: TJSONStringType;
+begin
+  Result:=IntToStr(FValue)
+end;
+
+procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType);
+begin
+  FValue:=StrToInt(AValue);
+end;
+
+
+function TJSONIntegerNumber.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONIntegerNumber.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:={$ifdef pas2js}Integer(AValue){$else}AValue{$endif};
+end;
+
+constructor TJSONIntegerNumber.Create(AValue: Integer);
+begin
+  FValue:=AValue;
+end;
+
+class function TJSONIntegerNumber.NumberType: TJSONNumberType;
+begin
+  Result:=ntInteger;
+end;
+
+procedure TJSONIntegerNumber.Clear;
+begin
+  FValue:=0;
+end;
+
+function TJSONIntegerNumber.Clone: TJSONData;
+
+begin
+  Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue);
+end;
+
+{$ifdef fpc}
+{ TJSONInt64Number }
+
+function TJSONInt64Number.GetAsInt64: Int64;
+begin
+  Result := FValue;
+end;
+
+function TJSONInt64Number.GetAsQWord: QWord;
+begin
+  Result := FValue;
+end;
+
+procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
+begin
+  FValue := AValue;
+end;
+
+procedure TJSONInt64Number.SetAsQword(const AValue: QWord);
+begin
+  FValue := AValue;
+end;
+
+function TJSONInt64Number.GetAsBoolean: Boolean;
+begin
+  Result:=FValue<>0;
+end;
+
+function TJSONInt64Number.GetAsFloat: TJSONFloat;
+begin
+  Result:= FValue;
+end;
+
+function TJSONInt64Number.GetAsInteger: Integer;
+begin
+  Result := FValue;
+end;
+
+procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
+begin
+  FValue:=Ord(AValue);
+end;
+
+procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
+begin
+  FValue:=Round(AValue);
+end;
+
+procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
+begin
+  FValue:=AValue;
+end;
+
+function TJSONInt64Number.GetAsJSON: TJSONStringType;
+begin
+  Result:=AsString;
+end;
+
+function TJSONInt64Number.GetAsString: TJSONStringType;
+begin
+  Result:=IntToStr(FValue)
+end;
+
+procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
+begin
+  FValue:=StrToInt64(AValue);
+end;
+
+function TJSONInt64Number.GetValue: TJSONVariant;
+begin
+  Result:=FValue;
+end;
+
+procedure TJSONInt64Number.SetValue(const AValue: TJSONVariant);
+begin
+  FValue:=AValue;
+end;
+
+constructor TJSONInt64Number.Create(AValue: Int64);
+begin
+  FValue := AValue;
+end;
+
+class function TJSONInt64Number.NumberType: TJSONNumberType;
+begin
+  Result:=ntInt64;
+end;
+
+procedure TJSONInt64Number.Clear;
+begin
+  FValue:=0;
+end;
+
+function TJSONInt64Number.Clone: TJSONData;
+
+begin
+  Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue);
+end;
+{$endif}
+
+{ TJSONArray }
+
+function TJSONArray.GetBooleans(Index : Integer): Boolean;
+begin
+  Result:=Items[Index].AsBoolean;
+end;
+
+function TJSONArray.GetArrays(Index : Integer): TJSONArray;
+begin
+  Result:=Items[Index] as TJSONArray;
+end;
+
+function TJSONArray.GetFloats(Index : Integer): TJSONFloat;
+begin
+  Result:=Items[Index].AsFloat;
+end;
+
+function TJSONArray.GetIntegers(Index : Integer): Integer;
+begin
+  Result:=Items[Index].AsInteger;
+end;
+
+{$ifdef fpc}
+function TJSONArray.GetInt64s(Index : Integer): Int64;
+begin
+  Result:=Items[Index].AsInt64;
+end;
+{$endif}
+
+function TJSONArray.GetNulls(Index : Integer): Boolean;
+begin
+  Result:=Items[Index].IsNull;
+end;
+
+function TJSONArray.GetObjects(Index : Integer): TJSONObject;
+begin
+  Result:=Items[Index] as TJSONObject;
+end;
+
+{$ifdef fpc}
+function TJSONArray.GetQWords(Index : Integer): QWord;
+begin
+  Result:=Items[Index].AsQWord;
+end;
+{$endif}
+
+function TJSONArray.GetStrings(Index : Integer): TJSONStringType;
+begin
+  Result:=Items[Index].AsString;
+end;
+
+{$ifdef fpc}
+function TJSONArray.GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
+begin
+  Result:=Items[Index].AsUnicodeString;
+end;
+{$endif}
+
+function TJSONArray.GetTypes(Index : Integer): TJSONType;
+begin
+  Result:=Items[Index].JSONType;
+end;
+
+procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray);
+begin
+  Items[Index]:=AValue;
+end;
+
+procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
+
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+
+procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+
+procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+{$endif}
+
+procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
+begin
+  Items[Index]:=AValue;
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.SetQWords(Index : Integer; AValue: QWord);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+{$endif}
+
+procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.SetUnicodeStrings(Index: Integer;
+  const AValue: TJSONUnicodeStringType);
+begin
+  Items[Index]:=CreateJSON(AValue);
+end;
+{$endif}
+
+function TJSONArray.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+
+Var
+  P,I : integer;
+  E : String;
+
+begin
+  if (APath<>'') and (APath[1]='[') then
+    begin
+    P:=Pos(']',APath);
+    I:=-1;
+    If (P>2) then
+      I:=StrToIntDef(Copy(APath,2,P-2),-1);
+    If (I>=0) and (I<Count) then
+       begin
+       E:=APath;
+       System.Delete(E,1,P);
+       Result:=Items[i].DoFindPath(E,NotFound);
+       end
+    else
+       begin
+       Result:=Nil;
+       If (P>0) then
+         NotFound:=Copy(APath,1,P)
+       else
+         NotFound:=APath;
+       end;
+    end
+  else
+    Result:=inherited DoFindPath(APath, NotFound);
+end;
+
+procedure TJSONArray.Converterror(From: Boolean);
+begin
+  If From then
+    DoError(SErrCannotConvertFromArray)
+  else
+    DoError(SErrCannotConvertToArray);
+end;
+
+{$warnings off}
+function TJSONArray.GetAsBoolean: Boolean;
+begin
+  ConvertError(True);
+  Result:=false;
+end;
+
+function TJSONArray.GetAsFloat: TJSONFloat;
+begin
+  ConvertError(True);
+  Result:=0.0;
+end;
+
+function TJSONArray.GetAsInteger: Integer;
+begin
+  ConvertError(True);
+  Result:=0;
+end;
+
+{$ifdef fpc}
+function TJSONArray.GetAsInt64: Int64;
+begin
+  ConvertError(True);
+end;
+
+function TJSONArray.GetAsQWord: QWord;
+begin
+  ConvertError(True);
+end;
+{$endif}
+
+procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
+begin
+  ConvertError(False);
+  if AValue then ;
+end;
+
+procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONArray.SetAsInteger(const AValue: Integer);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.SetAsInt64(const AValue: Int64);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONArray.SetAsQword(const AValue: QWord);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+{$endif}
+
+{$warnings on}
+
+
+function TJSONArray.GetAsJSON: TJSONStringType;
+
+Var
+  I : Integer;
+  Sep : String;
+  D : TJSONData;
+  V : TJSONStringType;
+
+begin
+  Sep:=TJSONData.FElementSep;
+  Result:='[';
+  For I:=0 to Count-1 do
+    begin
+    D:=Items[i];
+    if D<>Nil then
+      V:=D.AsJSON
+    else
+      V:='null';
+    Result:=Result+V;
+    If (I<Count-1) then
+      Result:=Result+Sep;
+    end;
+  Result:=Result+']';
+end;
+
+Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
+
+begin
+  If (foUseTabChar in Options) then
+    Result:=StringofChar(#9,Indent)
+  else
+    Result:=StringOfChar(' ',Indent);  
+end;
+
+function TJSONArray.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
+
+Var
+  I : Integer;
+  MultiLine : Boolean;
+  SkipWhiteSpace : Boolean;
+  Ind : String;
+  
+begin
+  Result:='[';
+  MultiLine:=Not (foSingleLineArray in Options);
+  SkipWhiteSpace:=foSkipWhiteSpace in Options;
+  Ind:=IndentString(Options, CurrentIndent+Indent);
+  if MultiLine then
+    Result:=Result+sLineBreak;
+  For I:=0 to Count-1 do
+    begin
+    if MultiLine then
+      Result:=Result+Ind;
+    if Items[i]=Nil then
+      Result:=Result+'null'
+    else
+      Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
+    If (I<Count-1) then
+      if MultiLine then
+        Result:=Result+','
+      else
+        Result:=Result+ElementSeps[SkipWhiteSpace];
+    if MultiLine then
+      Result:=Result+sLineBreak
+    end;
+  if MultiLine then
+    Result:=Result+IndentString(Options, CurrentIndent);
+  Result:=Result+']';
+end;
+
+
+{$warnings off}
+function TJSONArray.GetAsString: TJSONStringType;
+begin
+  ConvertError(True);
+  Result:='';
+end;
+
+procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
+begin
+  ConvertError(False);
+  if AValue='' then ;
+end;
+
+function TJSONArray.GetValue: TJSONVariant;
+begin
+  ConvertError(True);
+  Result:=0;
+end;
+
+procedure TJSONArray.SetValue(const AValue: TJSONVariant);
+begin
+  ConvertError(False);
+  {$ifdef pas2js}
+  if AValue=0 then ;
+  {$else}
+  if VarType(AValue)=0 then ;
+  {$endif}
+end;
+{$warnings on}
+
+function TJSONArray.GetCount: Integer;
+begin
+  Result:=FList.Count;
+end;
+
+function TJSONArray.GetItem(Index: Integer): TJSONData;
+begin
+  Result:=FList[Index] as TJSONData;
+end;
+
+procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
+begin
+  If (Index=FList.Count) then
+    FList.Add(AValue)
+  else
+    FList[Index]:=AValue;
+end;
+
+constructor TJSONArray.Create;
+begin
+  Flist:=TFPObjectList.Create(True);
+end;
+
+{$ifdef pas2js}
+Function VarRecToJSON(Const Element : jsvalue; const SourceType : String) : TJSONData;
+var
+  i: NativeInt;
+  VObject: TObject;
+begin
+  Result:=nil;
+  if Element=nil then
+    Result:=CreateJSON // TJSONNull
+  else if isBoolean(Element) then
+    Result:=CreateJSON(boolean(Element))
+  else if isString(Element) then
+    Result:=CreateJSON(String(Element))
+  else if isNumber(Element) then
+    begin
+    if isInteger(Element) then
+      begin
+      i:=NativeInt(Element);
+      if (i>=low(integer)) and (i<=high(integer)) then
+        Result:=CreateJSON(Integer(Element))
+      else
+        Result:=CreateJSON(TJSONFloat(Element));
+      end
+    else
+      Result:=CreateJSON(TJSONFloat(Element));
+    end
+  else if isObject(Element) and (Element is TObject) then
+    begin
+    VObject:=TObject(Element);
+    if VObject is TJSONData then
+      Result:=TJSONData(VObject)
+    else
+      TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
+    end
+  else
+    TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,jsTypeOf(Element)]);
+end;
+{$else}
+Function VarRecToJSON(Const Element : TVarRec; const SourceType : String) : TJSONData;
+
+begin
+  Result:=Nil;
+  With Element do
+    case VType of
+      vtInteger    : Result:=CreateJSON(VInteger);
+      vtBoolean    : Result:=CreateJSON(VBoolean);
+      vtChar       : Result:=CreateJSON(VChar);
+      vtExtended   : Result:=CreateJSON(VExtended^);
+      vtString     : Result:=CreateJSON(vString^);
+      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
+      vtPChar      : Result:=CreateJSON(StrPas(VPChar));
+      vtPointer    : If (VPointer<>Nil) then
+                       TJSONData.DoError(SErrPointerNotNil,[SourceType])
+                     else
+                       Result:=CreateJSON();
+      vtCurrency   : Result:=CreateJSON(vCurrency^);
+      vtInt64      : Result:=CreateJSON(vInt64^);
+      vtObject     : if (VObject is TJSONData) then
+                       Result:=TJSONData(VObject)
+                     else
+                       TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
+      //vtVariant    :
+    else
+      TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType])
+    end;
+end;
+{$endif}
+
+constructor TJSONArray.Create(const Elements: array of {$ifdef pas2js}jsvalue{$else}Const{$endif});
+
+Var
+  I : integer;
+  J : TJSONData;
+
+begin
+  Create;
+  For I:=Low(Elements) to High(Elements) do
+    begin
+    J:=VarRecToJSON(Elements[i],'Array');
+    Add(J);
+    end;
+end;
+
+destructor TJSONArray.Destroy;
+begin
+  FreeAndNil(FList);
+  inherited Destroy;
+end;
+
+class function TJSONArray.JSONType: TJSONType;
+begin
+  Result:=jtArray;
+end;
+
+function TJSONArray.Clone: TJSONData;
+
+Var
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  A:=TJSONArrayClass(ClassType).Create;
+  try
+    For I:=0 to Count-1 do
+      A.Add(Self.Items[I].Clone);
+    Result:=A;
+  except
+    A.Free;
+    Raise;
+  end;
+end;
+
+procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
+
+Var
+  I : Integer;
+  Cont : Boolean;
+  
+begin
+  I:=0;
+  Cont:=True;
+  While (I<FList.Count) and cont do
+    begin
+    Iterator(Items[i],Data,Cont);
+    Inc(I);
+    end;
+end;
+
+function TJSONArray.IndexOf(obj: TJSONData): Integer;
+begin
+  Result:=FList.IndexOf(Obj);
+end;
+
+function TJSONArray.GetEnumerator: TBaseJSONEnumerator;
+begin
+  Result:=TJSONArrayEnumerator.Create(Self);
+end;
+
+procedure TJSONArray.Clear;
+begin
+  FList.Clear;
+end;
+
+function TJSONArray.Add(Item: TJSONData): Integer;
+begin
+  Result:=FList.Add(Item);
+end;
+
+function TJSONArray.Add(I: Integer): Integer;
+begin
+  Result:=Add(CreateJSON(I));
+end;
+
+{$ifdef fpc}
+function TJSONArray.Add(I: Int64): Int64;
+begin
+  Result:=Add(CreateJSON(I));
+end;
+
+function TJSONArray.Add(I: QWord): QWord;
+begin
+  Result:=Add(CreateJSON(I));
+end;
+{$endif}
+
+function TJSONArray.Add(const S: String): Integer;
+begin
+  Result:=Add(CreateJSON(S));
+end;
+
+{$ifdef fpc}
+function TJSONArray.Add(const S: UnicodeString): Integer;
+begin
+  Result:=Add(CreateJSON(S));
+end;
+{$endif}
+
+function TJSONArray.Add: Integer;
+begin
+  Result:=Add(CreateJSON);
+end;
+
+function TJSONArray.Add(F: TJSONFloat): Integer;
+begin
+  Result:=Add(CreateJSON(F));
+end;
+
+function TJSONArray.Add(B: Boolean): Integer;
+begin
+  Result:=Add(CreateJSON(B));
+end;
+
+function TJSONArray.Add(AnArray: TJSONArray): Integer;
+begin
+  If (IndexOf(AnArray)<>-1) then
+    DoError(SErrCannotAddArrayTwice);
+  Result:=Add(TJSONData(AnArray));
+end;
+
+function TJSONArray.Add(AnObject: TJSONObject): Integer;
+begin
+  If (IndexOf(AnObject)<>-1) then
+    DoError(SErrCannotAddObjectTwice);
+  Result:=Add(TJSONData(AnObject));
+end;
+
+procedure TJSONArray.Delete(Index: Integer);
+begin
+  FList.Delete(Index);
+end;
+
+procedure TJSONArray.Exchange(Index1, Index2: Integer);
+begin
+  FList.Exchange(Index1, Index2);
+end;
+
+function TJSONArray.Extract(Item: TJSONData): TJSONData;
+begin
+  Result := TJSONData(FList.Extract(Item));
+end;
+
+function TJSONArray.Extract(Index: Integer): TJSONData;
+begin
+  Result := TJSONData(FList.Extract(FList.Items[Index]));
+end;
+
+procedure TJSONArray.Insert(Index: Integer);
+begin
+  Insert(Index,CreateJSON);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
+begin
+  FList.Insert(Index, Item);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; I: Integer);
+begin
+  FList.Insert(Index, CreateJSON(I));
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.Insert(Index: Integer; I: Int64);
+begin
+  FList.Insert(Index, CreateJSON(I));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; I: QWord);
+begin
+  FList.Insert(Index, CreateJSON(I));
+end;
+{$endif}
+
+procedure TJSONArray.Insert(Index: Integer; const S: String);
+begin
+  FList.Insert(Index, CreateJSON(S));
+end;
+
+{$ifdef fpc}
+procedure TJSONArray.Insert(Index: Integer; const S: UnicodeString);
+begin
+  FList.Insert(Index, CreateJSON(S));
+end;
+{$endif}
+
+procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
+begin
+  FList.Insert(Index, CreateJSON(F));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; B: Boolean);
+begin
+  FList.Insert(Index, CreateJSON(B));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
+begin
+  if (IndexOf(AnArray)<>-1) then
+    DoError(SErrCannotAddArrayTwice);
+  FList.Insert(Index, AnArray);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
+begin
+  if (IndexOf(AnObject)<>-1) then
+    DoError(SErrCannotAddObjectTwice);
+  FList.Insert(Index, AnObject);
+end;
+
+procedure TJSONArray.Move(CurIndex, NewIndex: Integer);
+begin
+  FList.Move(CurIndex, NewIndex);
+end;
+
+procedure TJSONArray.Remove(Item: TJSONData);
+begin
+  FList.Remove(Item);
+end;
+
+procedure TJSONArray.Sort(Compare: TListSortCompare);
+begin
+  FList.Sort(Compare);
+end;
+
+{ TJSONObject }
+
+function TJSONObject.GetArrays(const AName: String): TJSONArray;
+begin
+  Result:=GetElements(AName) as TJSONArray;
+end;
+
+function TJSONObject.GetBooleans(const AName: String): Boolean;
+begin
+  Result:=GetElements(AName).AsBoolean;
+end;
+
+function TJSONObject.GetElements(const AName: string): TJSONData;
+begin
+  {$ifdef pas2js}
+  if FHash.hasOwnProperty('%'+AName) then
+    Result:=TJSONData(FHash['%'+AName])
+  else
+    DoError(SErrNonexistentElement,[AName]);
+  {$else}
+  Result:=TJSONData(FHash.Find(AName));
+  If (Result=Nil) then
+    DoError(SErrNonexistentElement,[AName]);
+  {$endif}
+end;
+
+function TJSONObject.GetFloats(const AName: String): TJSONFloat;
+begin
+  Result:=GetElements(AName).AsFloat;
+end;
+
+function TJSONObject.GetIntegers(const AName: String): Integer;
+begin
+  Result:=GetElements(AName).AsInteger;
+end;
+
+{$ifdef fpc}
+function TJSONObject.GetInt64s(const AName: String): Int64;
+begin
+  Result:=GetElements(AName).AsInt64;
+end;
+{$endif}
+
+function TJSONObject.GetIsNull(const AName: String): Boolean;
+begin
+  Result:=GetElements(AName).IsNull;
+end;
+
+function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
+begin
+  {$ifdef pas2js}
+  if FNames=nil then
+    FNames:=TJSObject.getOwnPropertyNames(FHash);
+  if (Index<0) or (Index>=FCount) then
+    DoError(SListIndexError,[Index]);
+  Result:=copy(FNames[Index],2);
+  {$else}
+  Result:=FHash.NameOfIndex(Index);
+  {$endif}
+end;
+
+function TJSONObject.GetObjects(const AName : String): TJSONObject;
+begin
+  Result:=GetElements(AName) as TJSONObject;
+end;
+
+{$ifdef fpc}
+function TJSONObject.GetQWords(AName : String): QWord;
+begin
+  Result:=GetElements(AName).AsQWord;
+end;
+{$endif}
+
+function TJSONObject.GetStrings(const AName : String): TJSONStringType;
+begin
+  Result:=GetElements(AName).AsString;
+end;
+
+{$ifdef fpc}
+function TJSONObject.GetUnicodeStrings(const AName: String
+  ): TJSONUnicodeStringType;
+begin
+  Result:=GetElements(AName).AsUnicodeString;
+end;
+{$endif}
+
+function TJSONObject.GetTypes(const AName : String): TJSONType;
+begin
+  Result:=Getelements(Aname).JSONType;
+end;
+
+class function TJSONObject.GetUnquotedMemberNames: Boolean; {$ifdef fpc}static;{$endif}
+begin
+  Result:=FUnquotedMemberNames;
+end;
+
+procedure TJSONObject.SetArrays(const AName : String; const AValue: TJSONArray);
+
+begin
+  SetElements(AName,AVAlue);
+end;
+
+procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean);
+begin
+  SetElements(AName,CreateJSON(AVAlue));
+end;
+
+procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData);
+{$ifdef pas2js}
+begin
+  if not FHash.hasOwnProperty('%'+AName) then
+    inc(FCount);
+  FHash['%'+AName]:=AValue;
+  FNames:=nil;
+end;
+{$else}
+Var
+  Index : Integer;
+
+begin
+  Index:=FHash.FindIndexOf(AName);
+  If (Index=-1) then
+    FHash.Add(AName,AValue)
+  else
+    FHash.Items[Index]:=AValue; // Will free the previous value.
+end;
+{$endif}
+
+procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat);
+begin
+  SetElements(AName,CreateJSON(AVAlue));
+end;
+
+procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer);
+begin
+  SetElements(AName,CreateJSON(AVAlue));
+end;
+
+{$ifdef fpc}
+procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64);
+begin
+  SetElements(AName,CreateJSON(AVAlue));
+end;
+{$endif}
+
+procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean);
+begin
+  If Not AValue then
+    DoError(SErrCannotSetNotIsNull);
+  SetElements(AName,CreateJSON);
+end;
+
+procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject);
+begin
+  SetElements(AName,AValue);
+end;
+
+{$ifdef fpc}
+procedure TJSONObject.SetQWords(AName : String; AValue: QWord);
+begin
+  SetElements(AName,CreateJSON(AVAlue));
+end;
+{$endif}
+
+procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
+begin
+  SetElements(AName,CreateJSON(AValue));
+end;
+
+{$ifdef fpc}
+procedure TJSONObject.SetUnicodeStrings(const AName: String;
+  const AValue: TJSONUnicodeStringType);
+begin
+  SetElements(AName,CreateJSON(AValue));
+end;
+{$endif}
+
+class procedure TJSONObject.DetermineElementQuotes;
+
+begin
+  FObjStartSep:=ObjStartSeps[TJSONData.FCompressedJSON];
+  FObjEndSep:=ObjEndSeps[TJSONData.FCompressedJSON];
+  if TJSONData.FCompressedJSON then
+    FElementEnd:=UnSpacedQuoted[FUnquotedMemberNames]
+  else
+    FElementEnd:=SpacedQuoted[FUnquotedMemberNames];
+  FElementStart:=ElementStart[FUnquotedMemberNames]
+end;
+
+class procedure TJSONObject.SetUnquotedMemberNames(AValue: Boolean); {$ifdef fpc}static;{$endif}
+
+begin
+  if FUnquotedMemberNames=AValue then exit;
+  FUnquotedMemberNames:=AValue;
+  DetermineElementQuotes;
+end;
+
+function TJSONObject.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+
+Var
+  N: TJSONStringType;
+  L,P,P2 : Integer;
+
+begin
+  If (APath='') then
+    Exit(Self);
+  N:=APath;
+  L:=Length(N);
+  P:=1;
+  While (P<L) and (N[P]='.') do
+    inc(P);
+  P2:=P;
+  While (P2<=L) and (Not (N[P2] in ['.','['])) do
+    inc(P2);
+   N:=Copy(APath,P,P2-P);
+   If (N='') then
+     Result:=Self
+   else
+     begin
+     Result:=Find(N);
+     If Result=Nil then
+       NotFound:=N+Copy(APath,P2,L-P2)
+     else
+       begin
+       N:=Copy(APath,P2,L-P2+1);
+       Result:=Result.DoFindPath(N,NotFound);
+       end;
+     end;
+end;
+
+procedure TJSONObject.Converterror(From: Boolean);
+begin
+  If From then
+    DoError(SErrCannotConvertFromObject)
+  else
+    DoError(SErrCannotConvertToObject);
+end;
+
+{$warnings off}
+function TJSONObject.GetAsBoolean: Boolean;
+begin
+  ConvertError(True);
+  Result:=false;
+end;
+
+function TJSONObject.GetAsFloat: TJSONFloat;
+begin
+  ConvertError(True);
+  Result:=0.0;
+end;
+
+function TJSONObject.GetAsInteger: Integer;
+begin
+  ConvertError(True);
+  Result:=0;
+end;
+
+{$ifdef fpc}
+function TJSONObject.GetAsInt64: Int64;
+begin
+  ConvertError(True);
+end;
+
+function TJSONObject.GetAsQWord: QWord;
+begin
+  ConvertError(True);
+end;
+{$endif}
+
+procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
+begin
+  ConvertError(False);
+  if AValue then ;
+end;
+
+procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONObject.SetAsInteger(const AValue: Integer);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+{$ifdef fpc}
+procedure TJSONObject.SetAsInt64(const AValue: Int64);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+
+procedure TJSONObject.SetAsQword(const AValue: QWord);
+begin
+  ConvertError(False);
+  if AValue>0 then ;
+end;
+{$endif}
+
+{$warnings on}
+
+function TJSONObject.GetAsJSON: TJSONStringType;
+
+Var
+  I : Integer;
+  Sep : String;
+  V : TJSONStringType;
+  D : TJSONData;
+
+begin
+  Sep:=TJSONData.FElementSep;
+  Result:='';
+  For I:=0 to Count-1 do
+    begin
+    If (Result<>'') then
+      Result:=Result+Sep;
+    D:=Items[i];
+    if Assigned(D) then
+      V:=Items[I].AsJSON
+    else
+      V:='null';
+    Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+V;
+    end;
+  If (Result<>'') then
+    Result:=FObjStartSep+Result+FObjEndSep
+  else
+    Result:='{}';
+end;
+
+{$warnings off}
+function TJSONObject.GetAsString: TJSONStringType;
+begin
+  ConvertError(True);
+  Result:='';
+end;
+
+procedure TJSONObject.SetAsString(const AValue: TJSONStringType);
+begin
+  ConvertError(False);
+  if AValue='' then ;
+end;
+
+function TJSONObject.GetValue: TJSONVariant;
+begin
+  ConvertError(True);
+  Result:=0;
+end;
+
+procedure TJSONObject.SetValue(const AValue: TJSONVariant);
+begin
+  ConvertError(False);
+  {$ifdef pas2js}
+  if AValue=0 then ;
+  {$else}
+  if VarType(AValue)=0 then ;
+  {$endif}
+end;
+{$warnings on}
+
+function TJSONObject.GetCount: Integer;
+begin
+  {$ifdef pas2js}
+  Result:=FCount;
+  {$else}
+  Result:=FHash.Count;
+  {$endif}
+end;
+
+function TJSONObject.GetItem(Index: Integer): TJSONData;
+begin
+  {$ifdef pas2js}
+  Result:=GetElements(GetNameOf(Index));
+  {$else}
+  Result:=TJSONData(FHash.Items[Index]);
+  {$endif}
+end;
+
+procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData);
+begin
+  {$ifdef pas2js}
+  SetElements(GetNameOf(Index),AValue);
+  {$else}
+  FHash.Items[Index]:=AValue;
+  {$endif}
+end;
+
+constructor TJSONObject.Create;
+begin
+  {$ifdef pas2js}
+  FHash:=TJSObject.new;
+  {$else}
+  FHash:=TFPHashObjectList.Create(True);
+  {$endif}
+end;
+
+constructor TJSONObject.Create(const Elements: array of {$ifdef pas2js}jsvalue{$else}Const{$endif});
+
+Var
+  I : integer;
+  AName : String;
+  J : TJSONData;
+
+begin
+  Create;
+  If ((High(Elements)-Low(Elements)) mod 2)=0 then
+    DoError(SErrOddNumber);
+  I:=Low(Elements);
+  While I<=High(Elements) do
+    begin
+    {$ifdef pas2js}
+    if isString(Elements[I]) then
+      AName:=String(Elements[I])
+    else
+      DoError(SErrNameMustBeString,[I+1]);
+    {$else}
+    With Elements[i] do
+      Case VType of
+        vtChar       : AName:=VChar;
+        vtString     : AName:=vString^;
+        vtAnsiString : AName:=(AnsiString(vAnsiString));
+        vtPChar      : AName:=StrPas(VPChar);
+      else
+        DoError(SErrNameMustBeString,[I+1]);
+      end;
+    {$endif}
+    If (AName='') then
+      DoError(SErrNameMustBeString,[I+1]);
+    Inc(I);
+    J:=VarRecToJSON(Elements[i],'Object');
+    Add(AName,J);
+    Inc(I);
+    end;
+end;
+
+destructor TJSONObject.Destroy;
+begin
+  {$ifdef pas2js}
+  FHash:=nil;
+  {$else}
+  FreeAndNil(FHash);
+  {$endif}
+  inherited Destroy;
+end;
+
+class function TJSONObject.JSONType: TJSONType;
+begin
+  Result:=jtObject;
+end;
+
+function TJSONObject.Clone: TJSONData;
+
+Var
+  O : TJSONObject;
+  I: Integer;
+
+begin
+  O:=TJSONObjectClass(ClassType).Create;
+  try
+    For I:=0 to Count-1 do
+      O.Add(Self.Names[I],Self.Items[I].Clone);
+    Result:=O;
+  except
+    FreeAndNil(O);
+    Raise;
+  end;
+end;
+
+function TJSONObject.GetEnumerator: TBaseJSONEnumerator;
+begin
+  Result:=TJSONObjectEnumerator.Create(Self);
+end;
+
+
+function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
+
+Var
+  i : Integer;
+  S : TJSONStringType;
+  MultiLine,UseQuotes, SkipWhiteSpace,SkipWhiteSpaceOnlyLeading : Boolean;
+  NSep,Sep,Ind : String;
+  V : TJSONStringType;
+  D : TJSONData;
+
+begin
+  Result:='';
+  UseQuotes:=Not (foDoNotQuoteMembers in options);
+  MultiLine:=Not (foSingleLineObject in Options);
+  SkipWhiteSpace:=foSkipWhiteSpace in Options;
+  SkipWhiteSpaceOnlyLeading:=foSkipWhiteSpaceOnlyLeading in Options;
+  CurrentIndent:=CurrentIndent+Indent;
+  Ind:=IndentString(Options, CurrentIndent);
+  If SkipWhiteSpace then
+    begin
+    if SkipWhiteSpaceOnlyLeading then
+      NSep:=': '
+    else
+      NSep:=':'
+    end
+  else
+    NSep:=' : ';
+  If MultiLine then
+    Sep:=','+SLineBreak+Ind
+  else if SkipWhiteSpace then
+    Sep:=','
+  else
+    Sep:=', ';
+  For I:=0 to Count-1 do
+    begin
+    If (I>0) then
+      Result:=Result+Sep
+    else If MultiLine then
+      Result:=Result+Ind;
+    S:=StringToJSONString(Names[i]);
+    If UseQuotes then
+      S:='"'+S+'"';
+    D:=Items[i];
+    if D=Nil then
+      V:='null'
+    else
+      v:=Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    Result:=Result+S+NSep+V;
+    end;
+  If (Result<>'') then
+    begin
+    if MultiLine then
+      Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
+    else
+      Result:=ObjStartSeps[SkipWhiteSpace]+Result+ObjEndSeps[SkipWhiteSpace]
+    end
+  else
+    Result:='{}';
+end;
+
+procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
+{$ifdef pas2js}
+var
+  i: Integer;
+  Cont: Boolean;
+begin
+  if FNames=nil then
+    FNames:=TJSObject.getOwnPropertyNames(FHash);
+  Cont:=True;
+  for i:=0 to length(FNames) do
+    begin
+    Iterator(copy(FNames[I],2),TJSONData(FHash[FNames[i]]),Data,Cont);
+    if not Cont then break;
+    end;
+end;
+{$else}
+Var
+  I : Integer;
+  Cont : Boolean;
+
+begin
+  I:=0;
+  Cont:=True;
+  While (I<FHash.Count) and Cont do
+    begin
+    Iterator(Names[I],Items[i],Data,Cont);
+    Inc(I);
+    end;
+end;
+{$endif}
+
+function TJSONObject.IndexOf(Item: TJSONData): Integer;
+begin
+  {$ifdef pas2js}
+  if FNames=nil then
+    FNames:=TJSObject.getOwnPropertyNames(FHash);
+  for Result:=0 to length(FNames)-1 do
+    if TJSONData(FHash[FNames[Result]])=Item then exit;
+  Result:=-1;
+  {$else}
+  Result:=FHash.IndexOf(Item);
+  {$endif}
+end;
+
+function TJSONObject.IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
+begin
+  {$ifdef pas2js}
+  if FNames=nil then
+    FNames:=TJSObject.getOwnPropertyNames(FHash);
+  Result:=TJSArray(FNames).indexOf('%'+AName); // -1 if not found
+  {$else}
+  Result:=FHash.FindIndexOf(AName);
+  {$endif}
+  if (Result<0) and CaseInsensitive then
+    begin
+    Result:=Count-1;
+    While (Result>=0) and (CompareText(Names[Result],AName)<>0) do
+      Dec(Result);
+    end;
+end;
+
+procedure TJSONObject.Clear;
+begin
+  {$ifdef pas2js}
+  FCount:=0;
+  FHash:=TJSObject.new;
+  FNames:=nil;
+  {$else}
+  FHash.Clear;
+  {$endif}
+end;
+
+function TJSONObject.DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError : Boolean = True): Integer;
+begin
+  if {$ifdef pas2js}FHash.hasOwnProperty('%'+AName){$else}(IndexOfName(aName)<>-1){$endif} then
+    begin
+    if FreeOnError then
+      FreeAndNil(AValue);
+    DoError(SErrDuplicateValue,[aName]);
+    end;
+  {$ifdef pas2js}
+  FHash['%'+AName]:=AValue;
+  FNames:=nil;
+  inc(FCount);
+  Result:=FCount;
+  {$else}
+  Result:=FHash.Add(AName,AValue);
+  {$endif}
+end;
+
+function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData
+  ): Integer;
+begin
+  Result:=DoAdd(aName,AValue,False);
+end;
+
+function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
+  ): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+
+function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+
+function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+
+{$ifdef fpc}
+function TJSONObject.Add(const AName: String; AValue: TJSONUnicodeStringType
+  ): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+{$endif}
+
+function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+
+{$ifdef fpc}
+function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+
+function TJSONObject.Add(const AName: TJSONStringType; Avalue: QWord): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON(AValue));
+end;
+{$endif}
+
+function TJSONObject.Add(const AName: TJSONStringType): Integer;
+begin
+  Result:=DoAdd(AName,CreateJSON);
+end;
+
+function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
+  ): Integer;
+begin
+  Result:=DoAdd(AName,TJSONData(AValue),False);
+end;
+
+procedure TJSONObject.Delete(Index: Integer);
+begin
+  {$ifdef pas2js}
+  if (Index<0) or (Index>=FCount) then
+    DoError(SListIndexError,[Index]);
+  JSDelete(FHash,'%'+GetNameOf(Index));
+  FNames:=nil;
+  dec(FCount);
+  {$else}
+  FHash.Delete(Index);
+  {$endif}
+end;
+
+procedure TJSONObject.Delete(const AName: string);
+{$ifdef pas2js}
+begin
+  if not FHash.hasOwnProperty('%'+AName) then exit;
+  JSDelete(FHash,'%'+AName);
+  FNames:=nil;
+  dec(FCount);
+end;
+{$else}
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  if (I<>-1) then
+    Delete(I);
+end;
+{$endif}
+
+procedure TJSONObject.Remove(Item: TJSONData);
+{$ifdef pas2js}
+var AName: String;
+begin
+  for AName in FHash do
+    if FHash.hasOwnProperty(AName) and (FHash[AName]=Item) then
+      begin
+      JSDelete(FHash,AName);
+      FNames:=nil;
+      dec(FCount);
+      exit;
+      end;
+end;
+{$else}
+begin
+  FHash.Remove(Item);
+end;
+{$endif}
+
+{$ifdef fpc}
+function TJSONObject.Extract(Index: Integer): TJSONData;
+begin
+  Result:=Items[Index];
+  FHash.Extract(Result);
+end;
+
+function TJSONObject.Extract(const AName: string): TJSONData;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  if (I<>-1) then
+    Result:=Extract(I)
+  else
+    Result:=Nil
+end;
+{$endif}
+
+function TJSONObject.Get(const AName: String): TJSONVariant;
+{$ifdef pas2js}
+begin
+  if FHash.hasOwnProperty('%'+AName) then
+    Result:=TJSONData(FHash['%'+AName]).Value
+  else
+    Result:=nil;
+end;
+{$else}
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  If (I<>-1) then
+    Result:=Items[i].Value
+  else
+    Result:=Null;
+end;
+{$endif}
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
+  ): TJSONFloat;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsFloat
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: Integer
+  ): Integer;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsInteger
+  else
+    Result:=ADefault;
+end;
+
+{$ifdef fpc}
+function TJSONObject.Get(const AName: String; ADefault: Int64): Int64;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsInt64
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: QWord): QWord;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsQWord
+  else
+    Result:=ADefault;
+end;
+{$endif}
+
+function TJSONObject.Get(const AName: String; ADefault: Boolean
+  ): Boolean;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtBoolean);
+  If D<>Nil then
+    Result:=D.AsBoolean
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
+  ): TJSONStringType;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtString);
+  If (D<>Nil) then
+    Result:=D.AsString
+  else
+    Result:=ADefault;
+end;
+
+{$ifdef fpc}
+function TJSONObject.Get(const AName: String; ADefault: TJSONUnicodeStringType
+  ): TJSONUnicodeStringType;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtString);
+  If (D<>Nil) then
+    Result:=D.AsUnicodeString
+  else
+    Result:=ADefault;
+end;
+{$endif}
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONArray
+  ): TJSONArray;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtArray);
+  If (D<>Nil) then
+    Result:=TJSONArray(D)
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONObject
+  ): TJSONObject;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtObject);
+  If (D<>Nil) then
+    Result:=TJSONObject(D)
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Find(const AName: String): TJSONData;
+{$ifdef pas2js}
+begin
+  if FHash.hasOwnProperty('%'+AName) then
+    Result:=TJSONData(FHash['%'+AName])
+  else
+    Result:=nil;
+end;
+{$else}
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  If (I<>-1) then
+    Result:=Items[i]
+  else
+    Result:=Nil;
+end;
+{$endif}
+
+function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData;
+begin
+  Result:=Find(AName);
+  If Assigned(Result) and (Result.JSONType<>AType) then
+    Result:=Nil;
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
+begin
+  AValue := Find(key);
+  Result := assigned(AValue);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  Result := assigned(v) and (v.JSONType = jtObject);
+  if Result then
+    AValue := TJSONObject(v);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  Result := assigned(v) and (v.JSONType = jtArray);
+  if Result then
+    AValue := TJSONArray(v);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  Result := assigned(v) and (v.JSONType = jtString);
+  if Result then
+    AValue := TJSONString(v);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  Result := assigned(v) and (v.JSONType = jtBoolean);
+  if Result then
+    AValue := TJSONBoolean(v);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  Result := assigned(v) and (v.JSONType = jtNumber);
+  if Result then
+    AValue := TJSONNumber(v);
+end;
+
+initialization
+  // Need to force initialization;
+  TJSONData.DetermineElementSeparators;
+  TJSONObject.DetermineElementQuotes;
+end.
+

+ 1178 - 0
compiler/packages/fcl-json/src/fpjsonrtti.pp

@@ -0,0 +1,1178 @@
+unit fpjsonrtti;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, typinfo, fpjson, rttiutils, jsonparser;
+
+Const
+  RFC3339DateTimeFormat = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss';
+  RFC3339DateTimeFormatMsec = RFC3339DateTimeFormat+'.zzz';
+  
+
+Type
+
+  TJSONStreamEvent = Procedure (Sender : TObject; AObject : TObject; JSON : TJSONObject) of object;
+  TJSONPropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; var Res : TJSONData) of object;
+
+  TJSONStreamOption = (jsoStreamChildren,         // If set, children will be streamed in 'Children' Property
+                       jsoEnumeratedAsInteger,    // Write enumerated as integer. Default is string.
+                       jsoSetAsString,            // Write Set as a string. Default is an array.
+                       jsoSetEnumeratedAsInteger, // Write enumerateds in set array as integers.
+                       jsoSetBrackets,            // Use brackets when creating set as array
+                       jsoComponentsInline,       // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
+                       jsoTStringsAsArray,        // Stream TStrings as an array of strings. Associated objects are not streamed.
+                       jsoTStringsAsObject,       // Stream TStrings as an object : string = { object }
+                       jsoDateTimeAsString,       // Format a TDateTime value as a string
+                       jsoUseFormatString,        // Use FormatString when creating JSON strings.
+                       jsoCheckEmptyDateTime,     // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
+                       jsoLegacyDateTime,         // Set this to enable old date/time formatting. Current behaviour is to save date/time as a ISO 9601 value.
+                       jsoLowerPropertyNames,     // Set this to force lowercase names when streaming to JSON.
+                       jsoStreamTList             // Set this to assume that TList contains a list of TObjects. Use with care!
+                       );  
+  TJSONStreamOptions = Set of TJSONStreamOption;
+
+  TJSONFiler = Class(TComponent)
+  Protected
+    Procedure Error(Const Msg : String);
+    Procedure Error(Const FMT : String;  Args : Array of const);
+  end;
+
+  { TJSONStreamer }
+
+  TJSONStreamer = Class(TJSONFiler)
+  private
+    FAfterStreamObject: TJSONStreamEvent;
+    FBeforeStreamObject: TJSONStreamEvent;
+    FChildProperty: String;
+    FDateTimeFormat: String;
+    FOnStreamProperty: TJSONPropertyEvent;
+    FOptions: TJSONStreamOptions;
+    function GetChildProperty: String;
+    function IsChildStored: boolean;
+    function StreamChildren(AComp: TComponent): TJSONArray;
+  protected
+    function StreamClassProperty(Const AObject: TObject): TJSONData; virtual;
+    Function StreamProperty(Const AObject : TObject; Const PropertyName : String) : TJSONData;
+    Function StreamProperty(Const AObject : TObject; PropertyInfo : PPropInfo) : TJSONData;
+    Function FormatDateProp(const DateTime : TDateTime) : TJSONString;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy;override;
+    //
+    // Basic functions
+    //
+    // Use RTTI to stream object.
+    // If AObject is of type TStrings or TCollection, special treatment occurs:
+    // TStrings results in { Strings: [S,S,S] } or { Strings: { "S1" : O1, "S2" : O2 }} depending on Options.
+    // Collection results in { Items: [I,I,I] }
+    Function ObjectToJSON(Const AObject : TObject) : TJSONObject;
+    // Stream a collection - always returns an array
+    function StreamCollection(Const ACollection: TCollection): TJSONArray;
+    // Stream an objectlist - always returns an array
+    function StreamObjectList(Const AnObjectList: TObjectList): TJSONArray;
+    // Stream a List - always returns an array
+    function StreamTList(Const AList: TList): TJSONArray;
+    // Stream a TStrings instance as an array
+    function StreamTStringsArray(Const AStrings: TStrings): TJSONArray;
+    // Stream a TStrings instance as an object
+    function StreamTStringsObject(Const AStrings: TStrings): TJSONObject;
+    // Stream a TStrings instance. Takes into account Options.
+    function StreamTStrings(Const AStrings: TStrings): TJSONData;
+    // Stream a variant as JSON.
+    function StreamVariant(const Data: Variant): TJSONData; virtual;
+    //
+    // Some utility functions.
+    //
+    // Call ObjectToJSON and convert result to JSON String.
+    Function ObjectToJSONString(AObject : TObject) : TJSONStringType;
+    // Convert TSTrings to JSON string with array or Object.
+    Function StringsToJSON(Const Strings : TStrings; AsObject : Boolean = False) : TJSONStringType;
+    // Convert collection to JSON string
+    Function CollectionToJSON(Const ACollection : TCollection) : TJSONStringType;
+    // Convert variant to JSON String
+    Function VariantToJSON(Const Data : Variant) : TJSONStringType;
+  Published
+    // Format used when formatting DateTime values. Only used in conjunction with jsoDateTimeToString
+    Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
+    // Options to use when streaming
+    Property Options : TJSONStreamOptions Read FOptions Write FOptions;
+    // Called before streaming an object with ObjectToJSON
+    Property BeforeStreamObject : TJSONStreamEvent Read FBeforeStreamObject Write FBeforeStreamObject;
+    // Called After streaming an object with ObjectToJSON
+    Property AfterStreamObject : TJSONStreamEvent Read FAfterStreamObject Write FAfterStreamObject;
+    // Called whenever a property was streamed. If Res is nil on return, no property is added.
+    Property OnStreamProperty : TJSONPropertyEvent Read FOnStreamProperty Write FOnStreamProperty;
+    // Property name to use when streaming child components. Default is "Children"
+    Property ChildProperty : String Read GetChildProperty Write FChildProperty Stored IsChildStored;
+  end;
+
+  { TJSONDeStreamer }
+  TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
+  TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
+  TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
+  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors);
+  TJSONDestreamOptions = set of TJSONDestreamOption;
+
+  TJSONDeStreamer = Class(TJSONFiler)
+  private
+    FAfterReadObject: TJSONStreamEvent;
+    FBeforeReadObject: TJSONStreamEvent;
+    FDateTimeFormat: String;
+    FOnGetObject: TJSONGetObjectEvent;
+    FOnPropError: TJSONpropertyErrorEvent;
+    FOnRestoreProp: TJSONRestorePropertyEvent;
+    FCaseInsensitive : Boolean;
+    FOptions: TJSONDestreamOptions;
+    procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
+    function GetCaseInsensitive: Boolean;
+    procedure SetCaseInsensitive(AValue: Boolean);
+  protected
+    // Try to parse a date.
+    Function ExtractDateTime(S : String): TDateTime;
+    function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
+    procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
+    function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
+    procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
+    procedure DoAfterReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
+    Function ObjectFromString(Const JSON : TJSONStringType) : TJSONData; virtual;
+    procedure RestoreProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    // Convert JSON object to properties of AObject
+    Procedure JSONToObject(Const JSON : TJSONStringType; AObject : TObject);
+    Procedure JSONToObject(Const JSON : TJSONObject; AObject : TObject);
+    // Convert JSON object/array to collection.
+    Procedure JSONToCollection(Const JSON : TJSONStringType; ACollection : TCollection);
+    Procedure JSONToCollection(Const JSON : TJSONData; ACollection : TCollection);
+    // Convert JSON array/object/string to TStrings
+    Procedure JSONToStrings(Const JSON : TJSONStringType; AStrings : TSTrings);
+    Procedure JSONToStrings(Const JSON : TJSONData; AStrings : TSTrings);
+    // Convert JSON data to a variant. Supports simple data types and arrays.
+    Function JSONToVariant(Data: TJSONData): Variant;
+    Function JSONToVariant(Data: TJSONStringType): Variant;
+    // Triggered at the start of each call to JSONToObject
+    Property BeforeReadObject : TJSONStreamEvent Read FBeforeReadObject Write FBeforeReadObject;
+    // Triggered at the end of each call to JSONToObject (not if exception happens)
+    Property AfterReadObject : TJSONStreamEvent Read FAfterReadObject Write FAfterReadObject;
+    // Called when a property will be restored. If 'Handled' is True on return, property is considered restored.
+    Property OnRestoreProperty : TJSONRestorePropertyEvent Read FOnRestoreProp Write FOnRestoreProp;
+    // Called when an error occurs when restoring a property. If Continue is False on return, exception is re-raised.
+    Property OnPropertyError : TJSONpropertyErrorEvent Read FOnPropError Write FOnPropError;
+    // Called when a object-typed property must be restored, and the property is Nil. Must return an instance for the property.
+    // Published Properties of the instance will be further restored with available data.
+    Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
+    // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
+    Property CaseInsensitive : Boolean Read GetCaseInsensitive Write SetCaseInsensitive ; deprecated;
+    // DateTime format. If not set, RFC3339DateTimeFormat is assumed.
+    // If set, it will be used as an argument to ScanDateTime. If that fails, StrToDateTime is used.
+    Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
+    // Options overning the behaviour
+    Property Options : TJSONDestreamOptions Read FOptions Write FOptions;
+  end;
+
+  EJSONRTTI = Class(Exception);
+
+
+implementation
+
+uses dateutils, variants, rtlconsts;
+
+ResourceString
+  SErrUnknownPropertyKind     = 'Unknown property kind for property : "%s"';
+  SErrUnsupportedPropertyKind = 'Unsupported property kind for property: "%s"';
+  SErrUnsupportedVariantType  = 'Unsupported variant type : %d';
+  SErrUnsupportedArrayType    = 'JSON array cannot be streamed to object of class "%s"';
+  SErrUnsupportedJSONType     = 'Cannot destream object from JSON data of type "%s"';
+  SErrUnsupportedCollectionType = 'Unsupported JSON type for collections: "%s"';
+  SErrUnsupportedCollectionItemType = 'Array element %d is not a valid type for a collection item: "%s"';
+  SErrUnsupportedStringsItemType = 'Array element %d is not a valid type for a stringlist item: "%s"';
+  SErrUnsupportedStringsType = 'Unsupported JSON type for stringlists: "%s"';
+  SErrUnsupportedStringsObjectType = 'Object Element %s is not a valid type for a stringlist object: "%s"';
+  SErrUnSupportedEnumDataType = 'Unsupported JSON type for enumerated property "%s" : "%s"';
+  SErrUnsupportedVariantJSONType = 'Unsupported JSON type for variant value : "%s"';
+  SErrUnsupportedObjectData = 'Unsupported JSON type for object property: "%s"';
+
+{ TStreamChildrenHelper }
+
+Type
+  TSet = set of 0..31; // Used to (de)stream set properties.
+
+  TStreamChildrenHelper = Class
+  Private
+   FChildren : TJSONArray;
+   FStreamer:TJSONStreamer;
+   procedure StreamChild(AChild: TComponent);
+  public
+    Function StreamChildren(AComponent : TComponent; AStreamer : TJSONStreamer): TJSONArray;
+  end;
+
+  THackComponent = Class(TComponent);
+
+{ TJSONDeStreamer }
+
+function TJSONDeStreamer.ObjectFromString(const JSON: TJSONStringType): TJSONData;
+
+begin
+  With TJSONParser.Create(JSON) do
+    try
+      Result:=Parse;
+    finally
+      Free;
+    end;
+end;
+
+constructor TJSONDeStreamer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+destructor TJSONDeStreamer.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONStringType;
+  AObject: TObject);
+
+Var
+  D : TJSONData;
+
+begin
+  D:=ObjectFromString(JSON);
+
+  if not Assigned(D) then
+    Exit;
+
+  try
+    If D.JSONType=jtObject then
+      JSONToObject(D as TJSONObject,AObject)
+    else if D.JSONType=jtArray then
+      begin
+      If AObject is TStrings then
+        JSONToStrings(D,AObject as TSTrings)
+      else if AObject is TCollection then
+        JSONTOCollection(D,AObject as TCollection)
+      else
+        Error(SErrUnsupportedArrayType,[AObject.ClassName])
+      end
+    else if (D.JSONType=jtString) and (AObject is TStrings) then
+      JSONToStrings(D,AObject as TStrings)
+    else
+      Error(SErrUnsupportedJSONType,[JSONTypeName(D.JSONType)]);
+  finally
+    FreeAndNil(D);
+  end;
+end;
+
+function TJSONDeStreamer.JSONToVariant(Data: TJSONData): Variant;
+
+Var
+  I : integer;
+
+begin
+  Case Data.JSONType of
+    jtNumber :
+      Case TJSONNumber(Data).NumberType of
+        ntFloat   : Result:=Data.AsFloat;
+        ntInteger : Result:=Data.AsInteger;
+        ntInt64   : Result:=Data.Asint64;
+        ntQWord   : Result:=Data.AsQWord;
+      end;
+    jtString :
+      Result:=Data.AsString;
+    jtBoolean:
+      Result:=Data.AsBoolean;
+    jtNull:
+      Result:=Null;
+    jtArray :
+      begin
+      Result:=VarArrayCreate([0,Data.Count-1],varVariant);
+      For I:=0 to Data.Count-1 do
+        Result[i]:=JSONToVariant(Data.Items[i]);
+      end;
+  else
+    Error(SErrUnsupportedVariantJSONType,[GetEnumName(TypeInfo(TJSONType),Ord(Data.JSONType))]);
+  end;
+end;
+
+function TJSONDeStreamer.JSONToVariant(Data: TJSONStringType): Variant;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=ObjectFromString(Data);
+  try
+    Result:=JSONToVariant(D);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TJSONDeStreamer.DeStreamClassProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
+
+Var
+  O : TObject;
+
+begin
+  O:=GetObjectProp(AObject,PropInfo);
+  If O is TStrings then
+    JSONToStrings(PropData,O as TStrings)
+  else if (O is TCollection) then
+    JSONToCollection(PropData,O as TCollection)
+  else
+    begin
+    If (O=Nil) then
+      begin
+      If (PropData.JSONType=jtString) then
+        O:=GetObject(AObject,PropData.AsString,Nil,PropInfo)
+      else if (PropData.JSONType=jtObject) then
+        O:=GetObject(AObject,'',PropData as TJSONObject,PropInfo)
+      else
+        Error(SErrUnsupportedObjectData,[JsonTypeName(PropData.JSONType){GetEnumName(TypeInfo(TJSONType),Ord(PropData.JSONType))}]);
+      SetObjectProp(AObject,PropInfo,O);
+      end;
+    If (O<>Nil) and (PropData.JSONType=jtObject) then
+      JSONToObject(PropData as TJSONObject,O);
+    end;
+end;
+
+function TJSONDeStreamer.GetCaseInsensitive: Boolean;
+begin
+  Result:=jdoCaseInsensitive in Options;
+end;
+
+procedure TJSONDeStreamer.SetCaseInsensitive(AValue: Boolean);
+begin
+  if AValue then
+    Include(Foptions,jdoCaseInsensitive)
+  else
+    Exclude(Foptions,jdoCaseInsensitive);
+end;
+
+function TJSONDeStreamer.ExtractDateTime(S: String): TDateTime;
+
+Var
+  Fmt : String;
+  E,fmtSpecified : Boolean;
+
+begin
+  E:=False;
+  FMT:=DateTimeFormat;
+  fmtSpecified:=Fmt<>'';
+  if Not fmtSpecified then
+    FMT:=RFC3339DateTimeFormat;
+  Try
+    // No TryScanDateTime
+    Result:=ScanDatetime(FMT,S);
+  except
+    if fmtSpecified then
+      Raise
+    else
+      E:=True;
+  end;
+  if E then
+    if not TryStrToDateTime(S,Result) then
+      if not TryStrToDate(S,Result) then
+        if not TryStrToTime(S,Result) then
+          Raise EConvertError.CreateFmt(SInvalidDateTime,[S]);
+//  ExtractDateTime(PropData.AsString)
+end;
+
+procedure TJSONDeStreamer.RestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
+
+Var
+  B : Boolean;
+
+begin
+  try
+    B:=Not Assigned(FOnRestoreProp);
+    If Not B then
+      begin
+      FOnRestoreProp(Self,AObject,PropInfo,PropData,B);
+      If B then
+        exit;
+      end;
+    DoRestoreProperty(AObject,PropInfo,PropData);
+  except
+    On E : Exception do
+      If Assigned(FOnPropError) then
+        begin
+        B:=False;
+        FOnPropError(Self,AObject,PropInfo,PropData,E,B);
+        If Not B then
+          Raise;
+        end
+      else if Not (jdoIgnorePropertyErrors in Options) then
+        Raise;
+  end;
+end;
+
+procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
+
+Var
+  PI : PPropInfo;
+  TI : PTypeInfo;
+  I,J,S : Integer;
+  D : Double;
+  A : TJSONArray;
+  JS : TJSONStringType;
+begin
+  PI:=PropInfo;
+  TI:=PropInfo^.PropType;
+  case TI^.Kind of
+    tkUnknown :
+      Error(SErrUnknownPropertyKind,[PI^.Name]);
+    tkInteger :
+      SetOrdProp(AObject,PI,PropData.AsInteger);
+    tkInt64 :
+      SetOrdProp(AObject,PI,PropData.AsInt64);
+    tkEnumeration :
+      begin
+      if (PropData.JSONType=jtNumber) then
+        I:=PropData.AsInteger
+      else if PropData.JSONType=jtString then
+        I:=GetEnumValue(TI,PropData.AsString)
+      else
+        Error(SErrUnSupportedEnumDataType,[PI^.Name,GetEnumName(TypeInfo(TJSONType),Ord(PropData.JSONType))]);
+      SetOrdProp(AObject,PI,I);
+      end;
+    tkFloat :
+      begin
+      if (TI=TypeInfo(TDateTime)) and (PropData.JSONType=jtString) then
+        SetFloatProp(AObject,PI,ExtractDateTime(PropData.AsString))
+      else
+        SetFloatProp(AObject,PI,PropData.AsFloat)
+      end;
+    tkSet :
+      If PropData.JSONType=jtString then
+        SetSetProp(AObject,PI,PropData.AsString)
+      else if (PropData.JSONType=jtArray) then
+        begin
+        A:=PropData as TJSONArray;
+        TI:=GetTypeData(TI)^.CompType;
+        S:=0;
+        For I:=0 to A.Count-1 do
+          begin
+          if A.types[i]=jtNumber then
+            J:=A.Integers[i]
+          else
+            J:=GetEnumValue(TI,A.strings[i]);
+          TSet(S):=TSet(S)+[j];
+          end;
+        SetOrdProp(AObject,PI,S);
+        end;
+    tkChar:
+      begin
+      JS:=PropData.AsString;
+      If (JS<>'') then
+        SetOrdProp(AObject,PI,Ord(JS[1]));
+      end;
+    tkSString,
+    tkLString,
+    tkAString:
+      SetStrProp(AObject,PI,PropData.AsString);
+    tkWString :
+      SetWideStrProp(AObject,PI,PropData.AsUnicodeString);
+    tkVariant:
+      SetVariantProp(AObject,PI,JSONToVariant(PropData));
+    tkClass:
+      DeStreamClassProperty(AObject,PI,PropData);
+    tkWChar :
+      begin
+      JS:=PropData.asString;
+      If (JS<>'') then
+        SetOrdProp(AObject,PI,Ord(JS[1]));
+      end;
+    tkBool :
+      SetOrdProp(AObject,PI,Ord(PropData.AsBoolean));
+    tkQWord :
+      SetOrdProp(AObject,PI,Trunc(PropData.AsFloat));
+    tkObject,
+    tkArray,
+    tkRecord,
+    tkInterface,
+    tkDynArray,
+    tkInterfaceRaw,
+    tkProcVar,
+    tkMethod :
+      Error(SErrUnsupportedPropertyKind,[PI^.Name]);
+    tkUString :
+      SetUnicodeStrProp(AObject,PI,PropData.AsUnicodeString);
+    tkUChar:
+      begin
+      JS:=PropData.asString;
+      If (JS<>'') then
+        SetOrdProp(AObject,PI,Ord(JS[1]));
+      end;
+  end;
+end;
+
+function TJSONDeStreamer.DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData;
+var
+  J: Integer;
+begin
+  J := JSON.IndexOfName(PropInfo^.Name,(jdoCaseInsensitive in Options));
+  if J > -1 then
+    Result := JSON.Items[J]
+  else
+    Result := nil;
+end;
+
+procedure TJSONDeStreamer.DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject);
+begin
+  If Assigned(FBeforeReadObject) then
+    FBeforeReadObject(Self,AObject,JSON);
+end;
+
+procedure TJSONDeStreamer.DoAfterReadObject(Const JSON: TJSONObject; AObject: TObject);
+begin
+  If Assigned(FAfterReadObject) then
+    FAfterReadObject(Self,AObject,JSON)
+end;
+
+procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONObject; AObject: TObject
+  );
+Var
+  I : Integer;
+  PIL : TPropInfoList;
+  JD: TJSONData;
+
+begin
+  DoBeforeReadObject(JSON, AObject);
+  If (AObject is TStrings) then
+    JSONToStrings(JSON,AObject as TStrings)
+  else If (AObject is TCollection) then
+    JSONToCollection(JSON, AObject as TCollection)
+  else
+    begin
+    Pil:=TPropInfoList.Create(AObject,tkProperties);
+    try
+      For I:=0 to PIL.Count-1 do
+        begin
+        JD:=DoMapProperty(AObject, Pil.Items[i], JSON);
+        If Assigned(JD) then
+          RestoreProperty(AObject,PIL.Items[i],JD);
+        end;
+    finally
+      FreeAndNil(PIL);
+    end;
+    end;
+  DoAfterReadObject(JSON, AObject);
+end;
+
+procedure TJSONDeStreamer.JSONToCollection(const JSON: TJSONStringType;
+  ACollection: TCollection);
+Var
+  D : TJSONData;
+
+begin
+  D:=ObjectFromString(JSON);
+  try
+    if Assigned(D) then
+      JSONToCollection(D,ACollection);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TJSONDeStreamer.JSONToCollection(const JSON: TJSONData;
+  ACollection: TCollection);
+
+Var
+  I : integer;
+  A : TJSONArray;
+  O : TJSONObject;
+
+begin
+  If (JSON.JSONType=jtArray) then
+    A:=JSON As TJSONArray
+  else if JSON.JSONType=jtObject then
+    A:=(JSON as TJSONObject).Arrays['Items']
+  else
+    Error(SErrUnsupportedCollectionType,[JSONTypeName(JSON.JSONType)]);
+  ACollection.Clear;
+  For I:=0 to A.Count-1 do
+    If (A.Types[i]<>jtObject) then
+      Error(SErrUnsupportedCollectionItemType,[I,JSONTypeName(A.Types[I])])
+    else
+      JSONToObject(A.Objects[i],ACollection.Add);
+end;
+
+procedure TJSONDeStreamer.JSONToStrings(const JSON: TJSONStringType;
+  AStrings: TSTrings);
+Var
+  D : TJSONData;
+
+begin
+  D:=ObjectFromString(JSON);
+  try
+    JSONToStrings(D,AStrings);
+  finally
+    D.Free;
+  end;
+end;
+
+function TJSONDeStreamer.GetObject(AInstance: TObject;
+  const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo
+  ): TObject;
+
+Var
+  C : TClass;
+
+begin
+  Result:=Nil;
+  If Assigned(FOnGetObject) then
+    FOnGetObject(Self,AInstance,PropInfo,D,APropName,Result);
+  If (Result=Nil) and (AInstance is TComponent) and Assigned(PropInfo) then
+     begin
+     C:=GetTypeData(Propinfo^.PropType)^.ClassType;
+     If C.InheritsFrom(TComponent) then
+       Result:=TComponentClass(C).Create(TComponent(AInstance));
+     end;
+end;
+
+procedure TJSONDeStreamer.JSONToStrings(const JSON: TJSONData;
+  AStrings: TSTrings);
+
+Var
+  O  : TJSONObject;
+  D  : TJSONData;
+  I  : Integer;
+  IO : TObject;
+  N  : TJSONStringType;
+
+begin
+  Case JSON.JSONType of
+    jtString:
+      AStrings.Text:=JSON.AsString;
+    jtArray:
+      begin
+      AStrings.Clear;
+      For I:=0 to JSON.Count-1 do
+        begin
+        if not (JSON.Items[i].JSONType=jtString) then
+          Error(SErrUnsupportedStringsItemType,[i,JSONTypeName(JSON.Items[i].JSONType)]);
+        AStrings.Add(JSON.Items[i].AsString);
+        end;
+      end;
+    jtObject:
+      begin
+      O:=JSON As TJSONObject;
+      If (O.Count=1) and (O.Names[0]='Strings') and (O.Items[0].JSONType=jtArray) then
+        JSONToStrings(O.Items[0],AStrings)
+      else
+        begin
+        AStrings.Clear;
+        For I:=0 to O.Count-1 do
+          begin
+          D:=O.Items[i];
+          N:=O.Names[i];
+          If D.JSONType=jtNull then
+            IO:=Nil
+          else if D.JSONType=jtObject then
+            IO:=GetObject(AStrings,N,TJSONOBject(D),Nil)
+          else
+            Error(SErrUnsupportedStringsObjectType,[D,JSONTypeName(D.JSONType)]);
+          AStrings.AddObject(O.Names[i],IO);
+          end;
+        end;
+      end;
+  else
+    Error(SErrUnsupportedStringsType,[JSONTypeName(JSON.JSONType)]);
+  end;
+end;
+
+Procedure TStreamChildrenHelper.StreamChild(AChild : TComponent);
+
+begin
+  FChildren.Add(FStreamer.ObjectToJSON(AChild));
+end;
+
+Function TStreamChildrenHelper.StreamChildren(AComponent : TComponent; AStreamer : TJSONStreamer): TJSONArray;
+
+begin
+  FStreamer:=AStreamer;
+  Result:=TJSONArray.Create;
+  try
+    FChildren:=Result;
+    THackComponent(AComponent).GetChildren(@StreamChild,AComponent);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+{ TJSONFiler }
+
+procedure TJSONFiler.Error(Const Msg: String);
+begin
+  Raise EJSONRTTI.Create(Name+' : '+Msg);
+end;
+
+procedure TJSONFiler.Error(Const FMT: String; Args: array of const);
+begin
+  Raise EJSONRTTI.CreateFmt(Name+' : '+FMT,Args);
+end;
+
+{ TJSONStreamer }
+
+constructor TJSONStreamer.Create(AOwner: TComponent);
+begin
+  Inherited;
+end;
+
+destructor TJSONStreamer.Destroy;
+begin
+  Inherited;
+end;
+
+
+Function TJSONStreamer.StreamChildren(AComp : TComponent) : TJSONArray;
+
+begin
+  With TStreamChildrenHelper.Create do
+    try
+      Result:=StreamChildren(AComp,Self);
+    finally
+      Free;
+    end;
+end;
+
+function TJSONStreamer.GetChildProperty: String;
+begin
+  Result:=FChildProperty;
+  If (Result='') then
+    Result:='Children';
+end;
+
+function TJSONStreamer.IsChildStored: boolean;
+begin
+  Result:=(GetChildProperty<>'Children');
+end;
+
+function TJSONStreamer.ObjectToJSON(Const AObject: TObject): TJSONObject;
+
+Var
+  PIL : TPropInfoList;
+  PD : TJSONData;
+  I : Integer;
+
+begin
+  Result:=Nil;
+  If (AObject=Nil) then
+    Exit;
+  Result:=TJSONObject.Create;
+  try
+    If Assigned(FBeforeStreamObject) then
+      FBeforeStreamObject(Self,AObject,Result);
+    If AObject is TStrings then
+      Result.Add('Strings',StreamTStrings(Tstrings(AObject)))
+    else If AObject is TCollection then
+      Result.Add('Items',StreamCollection(TCollection(AObject)))
+    else If AObject is TObjectList then
+      Result.Add('Objects',StreamObjectList(TObjectList(AObject)))
+    else if (jsoStreamTlist in Options) and (AObject is TList) then
+      Result.Add('Objects', StreamTList(TList(AObject)))
+    else
+      begin
+      PIL:=TPropInfoList.Create(AObject,tkProperties);
+      try
+        For I:=0 to PIL.Count-1 do
+          begin
+          PD:=StreamProperty(AObject,PIL.Items[i]);
+            If (PD<>Nil) then begin
+              if jsoLowerPropertyNames in Options then
+                Result.Add(LowerCase(PIL.Items[I]^.Name),PD)
+              else
+            Result.Add(PIL.Items[I]^.Name,PD);
+          end;
+          end;
+      finally
+        FReeAndNil(Pil);
+      end;
+      If (jsoStreamChildren in Options) and (AObject is TComponent) then
+        Result.Add(ChildProperty,StreamChildren(TComponent(AObject)));
+      If Assigned(FAfterStreamObject) then
+        FAfterStreamObject(Self,AObject,Result);
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSONStreamer.StreamProperty(Const AObject: TObject; Const PropertyName : String): TJSONData;
+
+begin
+  Result:=StreamProperty(AObject,GetPropInfo(AObject,PropertyName));
+end;
+
+Function TJSONStreamer.StreamVariant(Const Data : Variant): TJSONData;
+
+Var
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  Result:=Nil;
+  If VarIsArray(Data) then
+    begin
+    A:=TJSONArray.Create;
+    try
+      For I:=VarArrayLowBound(Data,1) to VarArrayHighBound(Data,1) do
+        A.Add(StreamVariant(Data[i]));
+    except
+      FreeAndNil(A);
+      Raise;
+    end;
+    Exit(A);
+    end;
+  If VarIsEmpty(Data) or VarisNull(Data) or (Data=UnAssigned) then
+    Exit(TJSONNull.Create);
+  Case VarType(Data) of
+    varshortint,
+    varbyte,
+    varword,
+    varsmallint,
+    varinteger :
+      Result:=TJSONIntegerNumber.Create(Data);
+    varlongword,
+    varint64 :
+      Result:=TJSONInt64Number.Create(Data);
+    vardecimal,
+    varqword,
+    varsingle,
+    vardouble,
+    varCurrency :
+      Result:=TJSONFloatNumber.Create(Data);
+    varString,
+    varolestr :
+      Result:=TJSONString.Create(Data);
+    varboolean :
+      Result:=TJSONBoolean.Create(Data);
+    varDate :
+      if jsoDateTimeAsString in Options then
+        Result:=FormatDateProp(Data)
+      else
+        Result:=TJSONFloatNumber.Create(Data);
+  else
+    Error(SErrUnsupportedVariantType,[VarType(Data)])
+  end;
+end;
+
+function TJSONStreamer.ObjectToJSONString(AObject: TObject): TJSONStringType;
+
+Var
+  O : TJSONData;
+
+begin
+  O:=ObjectToJSON(AObject);
+  try
+    if (jsoUseFormatString in Options) then
+      Result:=O.FormatJSON()
+    else
+      Result:=O.AsJSON;
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+function TJSONStreamer.StringsToJSON(Const Strings: TStrings; AsObject: Boolean = False): TJSONStringType;
+
+Var
+  D : TJSONData;
+
+begin
+  If ASObject then
+    D:=StreamTSTringsObject(Strings)
+  else
+    D:=StreamTStringsArray(Strings);
+  try
+    if (jsoUseFormatString in Options) then
+      Result:=D.FormatJSON
+    else
+      Result:=D.AsJSON;
+  finally
+    FreeAndNil(D);
+  end;
+end;
+
+function TJSONStreamer.CollectionToJSON(const ACollection: TCollection
+  ): TJSONStringType;
+
+Var
+  D : TJSONArray;
+
+begin
+  D:=StreamCollection(ACollection);
+  try
+    if (jsoUseFormatString in Options) then
+      Result:=D.FormatJSON()
+    else
+    Result:=D.AsJSON;
+  finally
+    FreeAndNil(D);
+  end;
+end;
+
+function TJSONStreamer.VariantToJSON(const Data: Variant): TJSONStringType;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=StreamVariant(Data);
+  try
+    if (jsoUseFormatString in Options) then
+      Result:=D.FormatJSON()
+    else
+      Result:=D.AsJSON;
+  finally
+    FreeAndNil(D);
+  end;
+end;
+
+function TJSONStreamer.StreamTList(const AList: TList): TJSONArray;
+var
+  I : Integer;
+  o : TJSONObject;
+begin
+  Result:=TJSONArray.Create;
+  try
+    for I:=0 to AList.Count-1 do begin
+      o := ObjectToJSON(TObject(AList.Items[i]));
+      if Assigned(o) then
+        Result.Add(o);
+    end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+Function TJSONStreamer.StreamTStringsArray(Const AStrings : TStrings) : TJSONArray;
+
+Var
+  I : Integer;
+
+begin
+  Result:=TJSONArray.Create;
+  try
+    For I:=0 to AStrings.Count-1 do
+      Result.Add(AStrings[i]);
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSONStreamer.StreamTStringsObject(Const AStrings: TStrings): TJSONObject;
+
+Var
+  I : Integer;
+  O : TJSONData;
+
+begin
+  Result:=TJSONObject.Create;
+  try
+    For I:=0 to AStrings.Count-1 do
+      begin
+      O:=ObjectToJSON(AStrings.Objects[i]);
+      If O=Nil then
+        O:=TJSONNull.Create;
+      Result.Add(AStrings[i],O);
+      end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSONStreamer.StreamTStrings(Const AStrings: TStrings): TJSONData;
+begin
+  If jsoTStringsAsArray in Options then
+    Result:=StreamTStringsArray(AStrings)
+  else If jsoTStringsAsObject in Options then
+    Result:=StreamTStringsObject(AStrings)
+  else
+    Result:=TJSONString.Create(AStrings.Text);
+end;
+
+
+Function TJSONStreamer.StreamCollection(Const ACollection : TCollection) : TJSONArray;
+
+Var
+  I : Integer;
+
+begin
+  Result:=TJSONArray.Create;
+  try
+    For I:=0 to ACollection.Count-1 do
+      Result.Add(ObjectToJSON(ACollection.Items[i]));
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSONStreamer.StreamObjectList(const AnObjectList: TObjectList): TJSONArray;
+Var
+  I : Integer;
+
+begin
+  if not Assigned(AnObjectList) then
+    Result:=Nil;
+  Result:=TJSONArray.Create;
+  try
+    For I:=0 to AnObjectList.Count-1 do
+      Result.Add(ObjectToJSON(AnObjectList.Items[i]));
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
+function TJSONStreamer.StreamClassProperty(const AObject: TObject): TJSONData;
+
+Var
+  C : TCollection;
+  I : integer;
+
+begin
+  Result:=Nil;
+  If (AObject=Nil) then
+    Result:=TJSONNull.Create()
+  else if (AObject is TComponent) then
+    begin
+    if (csSubComponent in TComponent(AObject).ComponentStyle) or (jsoComponentsInline in Options) then
+      Result:=ObjectToJSON(AObject)
+    else
+      Result:=TJSONString.Create(TComponent(AObject).Name);
+    end
+  else if (AObject is TStrings) then
+    Result:=StreamTStrings(TStrings(AObject))
+  else if (AObject is TCollection) then
+    Result:=StreamCollection(TCollection(Aobject))
+  else If AObject is TObjectList then
+    Result:=StreamObjectList(TObjectList(AObject))
+  else // Normally, this is only TPersistent.
+    Result:=ObjectToJSON(AObject);
+end;
+
+function TJSONStreamer.StreamProperty(Const AObject: TObject; PropertyInfo: PPropInfo): TJSONData;
+
+Var
+  PI : PPropInfo;
+  PT : PTypeInfo;
+  S,I : integer;
+
+begin
+  Result:=Nil;
+  PI:=PropertyInfo;
+  PT:=PI^.PropType;
+  Case PT^.Kind of
+    tkUnknown :
+      Error(SErrUnknownPropertyKind,[PI^.Name]);
+    tkInteger :
+      Result:=TJSONIntegerNumber.Create(GetOrdProp(AObject,PI));
+    tkEnumeration :
+      if jsoEnumeratedAsInteger in Options then
+        Result:=TJSONIntegerNumber.Create(GetOrdProp(AObject,PI))
+      else
+        Result:=TJSONString.Create(GetEnumName(PT,GetOrdProp(AObject,PI)));
+    tkFloat :
+      if (PT=TypeInfo(TDateTime)) and (jsoDateTimeAsString in Options) then
+        Result:=FormatDateProp(GetFloatProp(AObject,PI))
+      else
+        Result:=TJSONFloatNumber.Create(GetFloatProp(AObject,PI));
+    tkSet :
+      If jsoSetAsString in Options then
+        Result:=TJSONString.Create(GetSetProp(AObject,PI,jsoSetBrackets in Options))
+      else
+        begin
+        PT:=GetTypeData(PT)^.CompType;
+        S:=GetOrdProp(AObject,PI);
+        Result:=TJSONArray.Create;
+        try
+          for i:=0 to 31 do
+            if (i in TSet(S)) then
+              if jsoSetEnumeratedAsInteger in Options then
+                TJSONArray(Result).Add(i)
+              else
+                TJSONArray(Result).Add(GetEnumName(PT, i));
+        except
+          FreeAndNil(Result);
+          Raise;
+        end;
+        end;
+    tkChar:
+      Result:=TJSONString.Create(Char(GetOrdProp(AObject,PI)));
+    tkSString,
+    tkLString,
+    tkAString:
+      Result:=TJSONString.Create(GetStrProp(AObject,PI));
+    tkWString :
+      Result:=TJSONString.Create(GetWideStrProp(AObject,PI));
+    tkVariant:
+      Result:=StreamVariant(GetVariantProp(AObject,PI));
+    tkClass:
+      Result:=StreamClassProperty(GetObjectProp(AObject,PI));
+    tkWChar :
+      Result:=TJSONString.Create(WideChar(GetOrdProp(AObject,PI)));
+    tkBool :
+      Result:=TJSONBoolean.Create(GetOrdProp(AObject,PropertyInfo)<>0);
+    tkInt64 :
+      Result:=TJSONInt64Number.Create(GetOrdProp(AObject,PropertyInfo));
+    tkQWord :
+      Result:=TJSONFloatNumber.Create(GetOrdProp(AObject,PropertyInfo));
+    tkObject :
+      Result:=ObjectToJSON(GetObjectProp(AObject,PropertyInfo));
+    tkArray,
+    tkRecord,
+    tkInterface,
+    tkDynArray,
+    tkInterfaceRaw,
+    tkProcVar,
+    tkMethod :
+      Error(SErrUnsupportedPropertyKind,[PI^.Name]);
+    tkUString :
+      Result:=TJSONString.Create(GetWideStrProp(AObject,PI));
+    tkUChar:
+      Result:=TJSONString.Create(UnicodeChar(GetOrdProp(AObject,PI)));
+  end;
+  If Assigned(FOnStreamProperty) then
+    FOnStreamProperty(Self,AObject,PI,Result);
+end;
+
+function TJSONStreamer.FormatDateProp(Const DateTime: TDateTime): TJSONString;
+
+Var
+  S: String;
+
+begin
+  if (jsoCheckEmptyDateTime in Options) and (DateTime=0) then
+    S:=''
+  else if (DateTimeFormat<>'') then
+    S:=FormatDateTime(DateTimeFormat,DateTime)
+  else if (jsoLegacyDateTime in options) then  
+    begin
+    if Frac(DateTime)=0 then
+      S:=DateToStr(DateTime)
+    else if Trunc(DateTime)=0 then
+      S:=TimeToStr(DateTime)
+    else
+      S:=DateTimeToStr(DateTime);
+    end
+  else
+    S:=FormatDateTime(RFC3339DateTimeFormat,DateTime);
+     
+  Result:=TJSONString.Create(S);
+end;
+
+end.
+

+ 1280 - 0
compiler/packages/fcl-json/src/fpjsontopas.pp

@@ -0,0 +1,1280 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Michael Van Canneyt
+
+    Converter unit to convert JSON object to object pascal classes.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit fpjsontopas;
+
+// TODO : Array of Array LoadFromJSON/SaveToJSON
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpjson, jsonparser;
+
+Type
+  EJSONToPascal = Class(EJSON);
+
+  { TPropertyMapItem }
+  TPropertyMapItem = Class(TCollectionItem)
+  private
+    FGenerated: Boolean;
+    FJSONType: TJSONType;
+    FParentTypeName: String;
+    FPath: String;
+    FPropertyName: String;
+    FSkipType: Boolean;
+    FTypeName: String;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+    Property Generated : Boolean Read FGenerated;
+  Published
+    Property Path : String Read FPath Write FPath;
+    Property TypeName : String Read FTypeName Write FTypeName;
+    Property ParentTypeName : String Read FParentTypeName Write FParentTypeName;
+    Property PropertyName : String Read FPropertyName Write FPropertyName;
+    Property JSONType : TJSONType Read FJSONType write FJSONType;
+    // Set this to true if no class/array should be generated
+    Property SkipType : Boolean Read FSkipType Write FSkipType;
+  end;
+
+  TPropertyMap = Class(TCollection)
+  private
+    function GetM(Aindex : Integer): TPropertyMapItem;
+    procedure SetM(Aindex : Integer; AValue: TPropertyMapItem);
+  Public
+    Function AddPath(Const APath,ATypeName : String) : TPropertyMapItem;
+    Function IndexOfPath(Const APath : String) : Integer;
+    Function FindPath(Const APath : String) : TPropertyMapItem;
+    Property Map[Aindex : Integer] : TPropertyMapItem Read GetM Write SetM; Default;
+  end;
+
+  { TJSONToPascal }
+  TJSONToPascalOption = (jpoUseSetter,jpoGenerateLoad,jpoUnknownLoadPropsError,jpoDelphiJSON, jpoLoadCaseInsensitive,jpoGenerateSave);
+  TJSONToPascalOptions = set of TJSONToPascalOption;
+
+  TJSONToPascal = Class(TComponent)
+  private
+    FExtraUnitNames: String;
+    FFieldPrefix: String;
+    FIndent : String;
+    FActive : Boolean;
+    FCode : TStrings;
+    FDefaultParentName : String;
+    FDestUnitName : String;
+    FIndentSize : Integer;
+    FJSON : TJSONStringType;
+    FJSONData: TJSONData;
+    FJSONStream: TStream;
+    FObjectConstructorArguments: String;
+    FOptions: TJSONToPascalOptions;
+    FPropertyMap: TPropertyMap;
+    FPropertyTypeSuffix: String;
+    FinType : Boolean; //  State
+    procedure GenerateSaveFunctionForm(M: TPropertyMapItem);
+    function GetObjectConstructorArguments: String;
+    function JSONDataName: String;
+    procedure MaybeEmitType;
+    procedure SetActive(AValue: Boolean);
+    procedure SetCode(AValue: TStrings);
+    procedure SetJSON(AValue: TJSONStringType);
+    procedure SetPropertyMap(AValue: TPropertyMap);
+  Protected
+    Procedure AddSemiColonToLastLine;
+    Procedure Indent;
+    Procedure Undent;
+    Procedure AddLn(Const Line : String);
+    Procedure AddLn(Const Fmt : String; Const Args : Array of const);
+    Procedure AddIndented(Const Line : String);
+    Procedure AddIndented(Const Fmt : String; Const Args : Array of const);
+    Function CreatePropertyMap : TPropertyMap; virtual;
+    Function GetJSONData(Out FreeResult : Boolean) : TJSONData; virtual;
+    function IsDateTimeValue(const AValue: String): Boolean; virtual;
+    Function GetDefaultParentName : String;
+    function GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String; virtual;
+    function PathToTypeName(const APath: String): String; virtual;
+    function AddToPath(const APath, AName: String): String;
+    class function CleanPropertyName(const AName: String): string;
+    function GetPropertyName(const APath, AName: String): String;
+
+    // Called for each type
+    function  GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String ): String;
+    function  GenerateAssignDelphi(IM: TPropertyMapItem; AVarName, AJSONName: String; AddSemiColon : Boolean ): String;
+    procedure GenerateCreateArray(M: TPropertyMapItem);
+    procedure GenerateSaveArray(M: TPropertyMapItem);
+    procedure GenerateCreateObjectfpJSON(M: TPropertyMapItem);
+    procedure GenerateLoadJSONDelphi(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateLoadJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateSaveJSONDelphi(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+    Function  GenerateArrayDeclaration(M: TPropertyMapItem; J: TJSONArray) : Boolean; virtual;
+    procedure GenerateObjectDeclaration(M: TPropertyMapItem;  J: TJSONObject); virtual;
+    procedure GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray); virtual;
+    procedure GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject); virtual;
+    // Top level routines
+    Function  GetExtraUnitNames : String; virtual;
+    Procedure ClearGeneratedTypes;virtual;
+    Procedure GenerateInterfaceHeader;virtual;
+    procedure GenerateDeclaration(const APath : String; J: TJSONData);  virtual;
+    Procedure GenerateImplementationHeader;virtual;
+    Procedure GenerateImplementation(const APath: String; J: TJSONData); virtual;
+    Procedure GenerateImplementationEnd;virtual;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute;
+    // JSON Data to generate code from.
+    Property JSONData : TJSONData Read FJSONData Write FJSONData;
+    // JSON Data (in stream form) to generate code from. JSONData takes prioroty over this property.
+    Property JSONStream : TStream Read FJSONStream Write FJSONStream;
+  Published
+    // Setting this to true will call execute. Can be used to generate code in the IDE.
+    Property Active : Boolean Read FActive Write SetActive;
+    // Options to use.
+    Property Options : TJSONToPascalOptions Read FOptions Write FOptions;
+    // The JSON to use. JSONData/JSONStream take priority over this property.
+    Property JSON : TJSONStringType Read FJSON Write SetJSON;
+    // This string
+    Property Code : TStrings Read FCode Write SetCode;
+    // Type information for generated types. After Execute, this will contain generated/detected types for all properties.
+    Property PropertyMap : TPropertyMap Read FPropertyMap Write SetPropertyMap;
+    // Generated unit name.
+    Property DestUnitName : String Read FDestUnitName Write FDestUnitName;
+    // Default Parent class name when declaring objects. Can be overridden per property.
+    Property DefaultParentName: String Read FDefaultParentName Write FDefaultParentName;
+    // Indent size
+    Property IndentSize : Integer Read FIndentSize Write FIndentSize default 2;
+    // These units (comma separated list) will be added to the interface uses clause.
+    Property ExtraUnitNames : String Read FExtraUnitNames Write FExtraUnitNames;
+    // This will be suffixed to an object/array type name when the propert map is constructed.
+    Property PropertyTypeSuffix : String Read FPropertyTypeSuffix Write FPropertyTypeSuffix;
+    // First letter for field name.
+    Property FieldPrefix : String Read FFieldPrefix Write FFieldPrefix;
+    // What are the arguments to a constructor ? This property is inserted literally in the code between ().
+    Property ObjectConstructorArguments : String Read FObjectConstructorArguments Write FObjectConstructorArguments;
+  end;
+
+
+
+implementation
+
+{$IFDEF VER2_6_4}
+Const
+  StructuredJSONTypes  = [jtArray,jtObject];
+{$ENDIF}
+
+{ TPropertyMap }
+
+function TPropertyMap.GetM(Aindex : Integer): TPropertyMapItem;
+begin
+  Result:=Items[AIndex] as TPropertyMapItem;
+end;
+
+procedure TPropertyMap.SetM(Aindex : Integer; AValue: TPropertyMapItem);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TPropertyMap.AddPath(const APath, ATypeName: String): TPropertyMapItem;
+begin
+  Result:=Add as TPropertyMapItem;
+  Result.Path:=APath;
+  Result.TypeName:=ATypeName;
+end;
+
+function TPropertyMap.IndexOfPath(const APath: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (GetM(Result).Path<>APath) do
+    Dec(Result);
+end;
+
+function TPropertyMap.FindPath(const APath: String): TPropertyMapItem;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfPath(APath);
+  If I=-1 then
+    Result:=Nil
+  else
+    Result:=GetM(I);
+end;
+
+{ TJSONToPascal }
+
+class function TJSONToPascal.CleanPropertyName(const AName: String): string;
+
+Const
+   KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+
+       'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+
+       'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+
+       'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+
+       'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+
+       'as;class;dispinterface;except;exports;finalization;finally;initialization;'+
+       'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+
+       'private;published;length;setlength;';
+Var
+  I : Integer;
+
+begin
+  Result:=Aname;
+  For I:=Length(Result) downto 1 do
+    If Not ((Upcase(Result[i]) in ['_','A'..'Z'])
+             or ((I>1) and (Result[i] in (['0'..'9'])))) then
+     Delete(Result,i,1);
+  if Pos(';'+lowercase(Result)+';',KW)<>0 then
+   Result:='_'+Result
+end;
+
+procedure TJSONToPascal.SetActive(AValue: Boolean);
+begin
+  if (FActive=AValue) then Exit;
+  if AValue then
+    Execute;
+end;
+
+procedure TJSONToPascal.SetCode(AValue: TStrings);
+begin
+  if FCode=AValue then Exit;
+  FCode.Assign(AValue);
+end;
+
+procedure TJSONToPascal.SetJSON(AValue: TJSONStringType);
+begin
+  if FJSON=AValue then Exit;
+  FJSON:=AValue;
+end;
+
+procedure TJSONToPascal.SetPropertyMap(AValue: TPropertyMap);
+begin
+  if FPropertyMap=AValue then Exit;
+  FPropertyMap.Assign(AValue);
+end;
+
+procedure TJSONToPascal.AddSemiColonToLastLine;
+
+Var
+  I : Integer;
+
+begin
+  I:=FCode.Count-1;
+  FCode[I]:=FCode[I]+';'
+end;
+
+procedure TJSONToPascal.Indent;
+begin
+  FIndent:=Findent+StringOfChar(' ',FIndentSize);
+end;
+
+procedure TJSONToPascal.Undent;
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(FIndent);
+  Dec(L,FIndentSize);
+  if L<0 then L:=0;
+  FIndent:=Copy(FIndent,1,L);
+end;
+
+procedure TJSONToPascal.AddLn(const Line: String);
+begin
+  FCode.Add(FIndent+Line);
+end;
+
+procedure TJSONToPascal.AddLn(const Fmt: String; const Args: array of const);
+begin
+  AddLn(Format(Fmt,Args));
+end;
+
+procedure TJSONToPascal.AddIndented(const Line: String);
+begin
+  Indent;
+  AddLn(Line);
+  Undent;
+end;
+
+procedure TJSONToPascal.AddIndented(const Fmt: String;
+  const Args: array of const);
+begin
+  Indent;
+  AddLn(Fmt,Args);
+  Undent;
+end;
+
+constructor TJSONToPascal.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FCode:=TStringList.Create;
+  FPropertyMap:=CreatePropertyMap;
+  FIndentSize:=2;
+  FFieldPrefix:='F';
+end;
+
+destructor TJSONToPascal.Destroy;
+begin
+  FreeAndNil(FCode);
+  FreeAndNil(FPropertyMap);
+  inherited Destroy;
+end;
+
+function TJSONToPascal.CreatePropertyMap: TPropertyMap;
+
+begin
+  Result:=TPropertyMap.Create(TPropertyMapItem);
+end;
+
+function TJSONToPascal.GetJSONData(out FreeResult: Boolean): TJSONData;
+
+Var
+  D : TJSONData;
+
+begin
+  FreeResult:=not Assigned(FJSONData);
+  if Not FreeResult then
+    Exit(FJSONData);
+  Result:=Nil;
+  If Assigned(JSONStream) then
+    D:=GetJSON(JSONStream)
+  else if (JSON<>'') then
+    D:=GetJSON(JSON)
+  else
+    Raise EJSONToPascal.Create('Need one of JSONObject, JSONStream or JSON to be set');
+  If Not (D.JSONType in [jtObject,jtArray]) then
+    begin
+    FreeAndNil(D);
+    Raise EJSONToPascal.Create('Provided JSONStream or JSON is not a JSON Object or array');
+    end;
+  Result:=D;
+end;
+
+function TJSONToPascal.GetExtraUnitNames: String;
+begin
+  Result:=FExtraUnitNames;
+end;
+
+procedure TJSONToPascal.ClearGeneratedTypes;
+
+Var
+  I : integer;
+
+begin
+  For i:=FPropertyMap.Count-1 downto 0 do
+    if FPropertyMap[i].Generated then
+      FPropertyMap.Delete(I);
+end;
+
+procedure TJSONToPascal.GenerateInterfaceHeader;
+
+Var
+  S: string;
+begin
+  AddLn('unit %s;',[DestUnitName]);
+  Addln('');
+  Addln('interface');
+  Addln('');
+  S:=Trim(GetExtraUnitNames);
+  if (S<>'') and (S[1]<>',') then
+    S:=', '+S;
+  if jpoDelphiJSON in Options then
+    S:='JSON'+S
+  else
+    S:='fpJSON'+S;
+  S:='SysUtils, Classes, '+S;
+  Addln('uses %s;',[s]);
+  Addln('');
+end;
+
+
+function TJSONToPascal.PathToTypeName(const APath: String): String;
+
+begin
+  Result:=StringReplace(Apath,'.','',[rfReplaceAll]);
+  Result:=StringReplace(Result,'[0]','Item',[rfReplaceAll]);
+  Result:=StringReplace(Result,'[]','Item',[rfReplaceAll]);
+  if Result='' then
+    Result:='TMyObject'
+  else
+    Result:='T'+Result+PropertyTypeSuffix;
+end;
+
+function TJSONToPascal.IsDateTimeValue(const AValue: String): Boolean;
+
+Var
+  D : TDateTime;
+
+begin
+  Result:=TryStrToDate(AValue,D);
+  if Not Result then
+    Result:=TryStrToTime(AValue,D);
+  if Not Result then
+    Result:=TryStrToDateTime(AValue,D);
+end;
+
+function TJSONToPascal.GetDefaultParentName: String;
+begin
+  Result:=FDefaultParentName;
+  if Result='' then
+    Result:='TObject';
+end;
+
+Resourcestring
+  SErrCannotDetermineType = 'Cannot determine type for %s : Not in type map';
+  SErrCannotDeterminePropertyType = 'Cannot determine property type for %s';
+  SErrCannotGenerateArrayDeclaration = 'Cannot generate array declaration from empty array at "%s"';
+
+function TJSONToPascal.GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String;
+
+Var
+  M : TPropertyMapItem;
+  IP : String;
+
+begin
+  Case AValue.JSONType of
+    jtBoolean : Result:='Boolean';
+    jtNull : Result:='Boolean';
+    jtNumber :
+      Case TJSONNumber(AValue).NumberType of
+        ntFloat : Result:='Double';
+        ntInt64 : Result:='Int64';
+        ntInteger : Result:='Integer';
+      end;
+    jtString :
+      if not IsDateTimeValue(AValue.AsString) then
+        Result:='String'
+      else
+        Result:='TDateTime';
+    jtArray:
+      begin
+      IP:=AddToPath(APath,AName);
+      M:=FPropertyMap.FindPath(IP);
+      If (M=Nil) then
+        raise EJSONToPascal.CreateFmt(SErrCannotDetermineType, [IP]);
+      if M.TypeName='' then
+        M.TypeName:='Array of '+GetPropertyTypeName(AddToPath(APath,AName)+'[0]','Item',TJSONArray(AValue)[0]);
+      Result:=M.TypeName;
+      end;
+    jtObject :
+      begin
+      M:=FPropertyMap.FindPath(AddToPath(APath,AName));
+      If (M=Nil) then // Can happen in case of [ [ {} ] ]
+        M:=FPropertyMap.AddPath(AddToPath(APath,AName),'');
+//        Raise EJSONToPascal.CreateFmt('Cannot determine type for %s.%s : Not in type map',[APath,AName]);
+      if M.TypeName='' then
+        M.TypeName:=PathToTypeName(AddToPath(APath,AName));
+      if M.ParentTypeName='' then
+         M.ParentTypeName:=GetDefaultParentName;
+      Result:=M.TypeName;
+      end;
+  end;
+end;
+
+function TJSONToPascal.GetPropertyName(const APath, AName: String): String;
+
+begin
+  Result:=CleanPropertyName(AName);
+end;
+
+function TJSONToPascal.JSONDataName: String;
+
+begin
+  if jpoDelphiJSON in options then
+    Result:='TJSONValue'
+  else
+    Result:='TJSONData';
+end;
+
+function TJSONToPascal.GenerateArrayDeclaration(M: TPropertyMapItem;
+  J: TJSONArray): Boolean;
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+  B : Boolean;
+
+begin
+  Result:=False;
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('%s = Array of %s;',[M.TypeName,IM.TypeName]);
+  B:=([jpoGenerateLoad,jpoGenerateSave] * options)<>[];
+  if B then
+    begin
+    Undent;
+    AddLn('');
+    end;
+  if jpoGenerateLoad in options then
+    AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]);
+  if jpoGenerateSave in options then
+    begin
+    AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray); overload;',[M.TypeName,M.TypeName]);
+    AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray; overload;',[M.TypeName,M.TypeName]);
+    end;
+  AddLn('');
+  if B then
+    begin
+    Indent;
+    FinType:=False;
+    Result:=True;
+    end;
+end;
+
+procedure TJSONToPascal.GenerateObjectDeclaration(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  E : TJSONEnum;
+  IM :  TPropertyMapItem;
+  IP, FRN,FWN : String;
+  HaveObj : Boolean;
+
+begin
+  HaveObj:=False;
+  Addln('');
+  AddLn('{ -----------------------------------------------------------------------');
+  Addln('  '+M.TypeName);
+  AddLn('  -----------------------------------------------------------------------}');
+  Addln('');
+  AddLn('%s = class(%s)',[M.TypeName,M.ParentTypeName]);
+  Addln('Private');
+  Indent;
+  For E in J do
+    begin
+    IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key));
+    If IM=Nil then
+      begin
+      IM:=FPropertyMap.Add as TPropertyMapItem;
+      IM.Path:=AddToPath(M.Path,E.Key);
+      IM.FGenerated:=True;
+      end;
+    if IM.TypeName='' then
+      IM.TypeName:=GetPropertyTypeName(M.Path,E.Key,E.Value);
+    if IM.PropertyName='' then
+      IM.PropertyName:=GetPropertyName(M.Path,E.Key);
+    IM.JSONType:=E.Value.JSONtype;
+    AddLn('F%s : %s;',[IM.PropertyName,IM.TypeName]);
+    HaveObj:=HaveObj or (IM.JSONType=jtObject);
+    end;
+  Undent;
+  if jpoUseSetter in Options then
+    begin
+    Addln('Protected');
+    Indent;
+    For E in J do
+      begin
+      IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key));
+      If IM=Nil then
+        raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [AddToPath(M.Path, E.Key)]);
+      FRN:=FieldPrefix+IM.PropertyName;
+      AddLn('Procedure Set%s(AValue : %s); virtual;',[IM.PropertyName,IM.TypeName]);
+      end;
+    Undent;
+    end;
+  Addln('Public');
+  Indent;
+  if HaveObj then
+    AddLn('Destructor Destroy; override;');
+  if jpoGenerateLoad in options then
+    begin
+    AddLn('Constructor CreateFromJSON(AJSON : %s); virtual;',[JSONDataName]);
+    AddLn('Procedure LoadFromJSON(AJSON : %s); virtual;',[JSONDataName]);
+    end;
+  if jpoGenerateSave in options then
+    begin
+    AddLn('Function SaveToJSON : TJSONObject; overload;');
+    AddLn('Procedure SaveToJSON(AJSON : TJSONObject); overload; virtual;');
+    end;
+
+  For E in J do
+    begin
+    IP:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(IP);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [IP]);
+    FRN:=FieldPrefix+IM.PropertyName;
+    if jpoUseSetter in Options then
+      FWN:='Set'+IM.PropertyName
+    else
+      FWN:=FRN;
+    AddLn('Property %s : %s Read %s Write %s;',[IM.PropertyName,IM.TypeName,FRN, FWN]);
+    end;
+  Undent;
+  AddLn('end;');
+end;
+
+function TJSONToPascal.AddToPath(const APath, AName: String): String;
+
+begin
+  Result:=APath;
+  if (AName<>'') then
+    begin
+    if (Result<>'') and (AName[1]<>'[') then
+      Result:=Result+'.';
+    Result:=Result+AName;
+    end;
+end;
+
+procedure TJSONToPascal.MaybeEmitType;
+
+begin
+  if FinType then exit;
+  Undent;
+  AddLn('');
+  AddLn('Type');
+  Indent;
+  FinType:=True;
+end;
+
+procedure TJSONToPascal.GenerateDeclaration(const APath: String;J: TJSONData);
+
+Var
+  M :  TPropertyMapItem;
+  O : TJSONEnum;
+  IP : String;
+
+begin
+  M:=FPropertyMap.FindPath(APath);
+  If M=Nil then
+    begin
+    M:=FPropertyMap.Add as TPropertyMapItem;
+    M.Path:=APath;
+    M.FGenerated:=True;
+    end
+  else if M.SkipType then
+    exit;
+  if (M.TypeName='') then
+    if J.JSONType in StructuredJSONtypes then
+      M.TypeName:=PathToTypeName(APath)
+    else
+      M.TypeName:=GetPropertyTypeName(APath,'',J);
+  M.JSONType:=J.JSONType;
+  if J is TJSONArray then
+    begin
+    M.ParentTypeName:='';
+    if J.Count=0 then
+      raise EJSONToPascal.CreateFmt(SErrCannotGenerateArrayDeclaration, [APath]);
+    IP:=AddToPath(M.Path,'[0]');
+    GenerateDeclaration(IP,J.Items[0]);
+    MaybeEmitType;
+    Addln('');
+    GenerateArrayDeclaration(M,TJSONarray(J));
+    end
+  else if J is TJSONObject then
+    begin
+    For O in TJSONOBject(J) do
+      begin
+      IP:=AddToPath(APath,O.Key);
+      GenerateDeclaration(IP,O.Value);
+      end;
+    M.ParentTypeName:=GetDefaultParentName;
+    MaybeEmitType;
+    Addln('');
+    GenerateObjectDeclaration(M,TJSONObject(J));
+    end;
+end;
+
+procedure TJSONToPascal.GenerateImplementationHeader;
+begin
+  Addln('');
+  Addln('implementation');
+  Addln('');
+end;
+
+procedure TJSONToPascal.GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray);
+
+Var
+  IM : TPropertyMapItem;
+  P : String;
+
+begin
+  P:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(P);
+  if J.Items[0] is TJSONObject then
+    GenerateObjectImplementation(IM,J.Items[0] as TJSONObject)
+  else if J.Items[0] is TJSONArray then
+    GenerateArrayImplementation(IM,J.Items[0] as TJSONArray);
+  if jpoGenerateLoad in Options then
+    GenerateCreateArray(M);
+  if jpoGenerateSave in Options then
+    GenerateSaveArray(M)
+  // Do nothing yet
+end;
+
+procedure TJSONToPascal.GenerateCreateArray(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]);
+  AddLn('');
+  AddLn('var');
+  AddIndented('I : integer;');
+  if (jpoDelphiJSON in Options) then
+    AddIndented('A : TJSONArray;');
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  if not (jpoDelphiJSON in Options) then
+    begin
+    AddLn('SetLength(Result,AJSON.Count);');
+    AddLn('For I:=0 to AJSON.Count-1 do');
+    AddIndented(GenerateAssign(IM,'Result[i]','AJSON.Items[i]'));
+    end
+  else
+    begin
+    AddLn('A:=AJSON as TJSONArray;');
+    AddLn('SetLength(Result,A.Count);');
+    AddLn('For I:=0 to A.Count-1 do');
+    AddIndented(GenerateAssignDelphi(IM,'Result[i]','A.Items[i]',True));
+    end;
+  Undent;
+  Addln('End;');
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateSaveArray(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray;',[M.TypeName,M.TypeName]);
+  AddLn('begin');
+  Indent;
+  Addln('Result:=TJSONArray.Create;');
+  Addln('Try');
+  AddIndented('Save%sToJSON(AnArray,Result);',[M.TypeName]);
+  Addln('Except');
+  Indent;
+  Addln('FreeAndNil(Result);');
+  Addln('Raise;');
+  Undent;
+  Addln('end;');
+  Undent;
+  Addln('end;');
+  AddLn('');
+  AddLn('');
+  AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray);',[M.TypeName,M.TypeName]);
+  AddLn('');
+  AddLn('var');
+  AddIndented('I : integer;');
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  AddLn('For I:=0 to Length(AnArray)-1 do');
+  Case IM.JSONType of
+    jtObject : AddIndented('AJSONArray.Add(AnArray[i].SaveToJSON);');
+    jtArray :  AddIndented('AJSONArray.Add(Save%sToJSON(AnArray[i]));',[IM.TypeName]);
+  else
+    AddIndented('AJSONArray.Add(AnArray[i]);');
+  end;
+  Undent;
+  Addln('end;');
+  AddLn('');
+end;
+
+function TJSONToPascal.GetObjectConstructorArguments: String;
+
+begin
+  Result:=ObjectConstructorArguments
+end;
+
+procedure TJSONToPascal.GenerateCreateObjectfpJSON(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  Indent;
+  AddLn('Function CreateObject%s(AnObject : TJSONData) : %s;',[M.TypeName,M.TypeName]);
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  AddLn('Result:='+M.TypeName+'.Create('+GetObjectConstructorArguments+');');
+  AddLn('Result.LoadFromJSON(AnObject);');
+  Undent;
+  Addln('End;');
+  Undent;
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateLoadJSONDelphi(M: TPropertyMapItem;
+  J: TJSONObject);
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P,K : String;
+  SElse : String;
+
+begin
+  AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONValue);',[M.TypeName]);
+  Addln('');
+  Addln('var');
+  AddIndented('P : TJSONPair;');
+  AddIndented('O : TJSONObject;');
+  AddIndented('PN : String;');
+  Addln('');
+  Addln('begin');
+  Indent;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('if not (AJSON is TJSONObject) then');
+    AddIndented('Raise EJSONException.CreateFmt(''"%s" : Cannot load from : "%s"'',[ClassName,AJSON.ClassName]);');
+    end
+  else
+    Addln('if not (AJSON is TJSONObject) then exit;');
+  Addln('O:=AJSON as TJSONObject;');
+  Addln('for P in O do');
+  Indent;
+  Addln('begin');
+  if jpoLoadCaseInsensitive in Options then
+    Addln('PN:=LowerCase(P.JSONString.Value);')
+  else
+    Addln('PN:=P.JSONString.Value;');
+  SElse:='';
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    K:=E.Key;
+    If jpoLoadCaseInsensitive in Options then
+      K:=LowerCase(K);
+    Addln(SElse+'If (PN=''%s'') then',[K]);
+    IM.JSONType:=E.Value.JSONType;
+    AddIndented(GenerateAssignDelphi(IM,IM.PropertyName,'P.JSONValue',False));
+    if SElse='' then
+      SElse:='else '
+    end;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('else');
+    AddIndented('Raise EJSONException.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,PN]);');
+    end
+  else
+    AddSemiColonToLastLine;
+  Addln('end;'); // For loop
+  Undent;
+  Undent;
+  Addln('end;');
+end;
+
+function TJSONToPascal.GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String): String;
+
+Var
+  T : String;
+  C : Boolean;
+
+begin
+  T:='';
+  Case LowerCase(IM.TypeName) of
+    'boolean' : T:='AsBoolean';
+    'string'  : T:='AsString';
+    'double'  : T:='AsFloat';
+    'integer' : T:='AsInteger';
+    'int64'   : T:='AsInt64';
+    'qword'   : T:='AsQWord';
+  else
+    if IM.JSONType=jtArray then
+      Result:=Format('%s:=Create%s(%s);',[AVarName,IM.TypeName,AJSONName])
+    else if IM.JSONType=jtObject then
+      Result:=Format('%s:=%s.CreateFromJSON(%s);',[AVarName,IM.TypeName,AJSONName])
+    else
+      Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]);
+  end;
+  if T<>'' then
+    Result:=Format('%s:=%s.%s;',[AVarName,AJSONName,T]);
+end;
+
+function TJSONToPascal.GenerateAssignDelphi(IM: TPropertyMapItem; AVarName,
+  AJSONName: String; AddSemiColon: Boolean): String;
+
+Var
+  T : String;
+
+begin
+  T:='';
+  Case LowerCase(IM.TypeName) of
+    'boolean' : T:='Boolean';
+    'string'  : T:='String';
+    'double'  : T:='Double';
+    'integer' : T:='Integer';
+    'int64'   : T:='Int64';
+    'qword'   : T:='Int64';
+  else
+    if IM.JSONType=jtArray then
+      Result:=Format('%s:=Create%s(%s)',[AVarName,IM.TypeName,AJSONName])
+    else if IM.JSONType=jtObject then
+      Result:=Format('%s:=%s.CreateFromJSON(%s)',[AVarName,IM.TypeName,AJSONName])
+    else
+      Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]);
+  end;
+  if T<>'' then
+    Result:=Format('%s:=%s.GetValue<%s>',[AVarName,AJSONName,T]);
+  If AddSemicolon then
+    Result:=Result+';'
+end;
+
+procedure TJSONToPascal.GenerateLoadJSONfpJSON(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P : String;
+
+begin
+  AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONData);',[M.TypeName]);
+  Addln('');
+  Addln('var');
+  AddIndented('E : TJSONEnum;');
+  Addln('');
+  Addln('begin');
+  Indent;
+  Addln('for E in AJSON do');
+  Indent;
+  Addln('begin');
+  if jpoLoadCaseInsensitive in Options then
+    Addln('case lowercase(E.Key) of')
+  else
+    Addln('case E.Key of');
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    if jpoLoadCaseInsensitive in Options then
+      Addln('''%s'':',[LowerCase(E.Key)])
+    else
+      Addln('''%s'':',[E.Key]);
+    IM.JSONType:=E.Value.JSONType;
+    AddIndented(GenerateAssign(IM,IM.PropertyName,'E.Value'));
+    end;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('else');
+    AddIndented('Raise EJSON.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,E.Key]);');
+    end;
+  Addln('end;'); // Case
+  Addln('end;'); // For loop
+  Undent;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateSaveFunctionForm(M: TPropertyMapItem);
+
+begin
+  AddLn('Function  %s.SaveToJSON : TJSONObject;',[M.TypeName]);
+  AddLn('begin');
+  Indent;
+  AddLn('Result:=TJSONObject.Create;');
+  AddLn('Try');
+  AddIndented('SaveToJSON(Result);');
+  AddLn('except');
+  Indent;
+    Addln('FreeAndNil(Result);');
+    AddLn('Raise;');
+  Undent;
+  AddLn('end;');
+  Undent;
+  AddLn('end;');
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateSaveJSONDelphi(M: TPropertyMapItem;  J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  T,P : String;
+  B,C : Boolean; // B : Indent called. C : Need to create value
+
+begin
+  GenerateSaveFunctionForm(M);
+  AddLn('');
+  AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]);
+  Addln('');
+  Addln('begin');
+  Indent;
+  For E in J do
+    begin
+    B:=False;
+    C:=True;
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    Case LowerCase(IM.TypeName) of
+      'boolean' : T:='Boolean';
+      'string'  : T:='String';
+      'double'  : T:='Number';
+      'integer' : T:='Number';
+      'int64'   : T:='Number';
+      'qword'   : T:='Number';
+    else
+      C:=False;
+      if IM.JSONType=jtArray then
+        T:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName])
+      else if IM.JSONType=jtObject then
+        begin
+        Addln('If Assigned(%s) then',[IM.PropertyName]);
+        T:=Format('%s.SaveToJSON',[IM.PropertyName]);
+        B:=True; // Indent called
+        Indent;
+        end;
+    end;
+    if C then
+      T:='TJSON'+T+'.Create('+IM.PropertyName+')';
+    if (T<>'') then
+      AddLn('AJSON.AddPair(''%s'',%s);',[E.Key,T]);
+    if B then
+      Undent;
+    end;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  T,P : String;
+  B : Boolean;
+
+begin
+  GenerateSaveFunctionForm(M);
+  AddLn('');
+  AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]);
+  Addln('');
+  Addln('begin');
+  Indent;
+  For E in J do
+    begin
+    B:=False;
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    Case LowerCase(IM.TypeName) of
+      'boolean' : T:=IM.PropertyName;
+      'string'  : T:=IM.PropertyName;
+      'double'  : T:=IM.PropertyName;
+      'integer' : T:=IM.PropertyName;
+      'int64'   : T:=IM.PropertyName;
+      'qword'   : T:=IM.PropertyName;
+    else
+      if IM.JSONType=jtArray then
+        t:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName])
+      else if IM.JSONType=jtObject then
+        begin
+        Addln('If Assigned(%s) then',[IM.PropertyName]);
+        T:=Format('%s.SaveToJSON',[IM.PropertyName]);
+        B:=True; // Indent called
+        Indent;
+        end;
+    end;
+    if (T<>'') then
+      AddLn('AJSON.Add(''%s'',%s);',[E.Key,T]);
+    if B then
+      Undent;
+    end;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P,FRN : String;
+  HaveObj : Boolean;
+
+begin
+  HaveObj:=False;
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM<>Nil then
+      HaveObj:=HaveObj or (IM.JSONType=jtObject);
+    end;
+  Addln('');
+  AddLn('{ -----------------------------------------------------------------------');
+  Addln('  '+M.TypeName);
+  AddLn('  -----------------------------------------------------------------------}');
+  Addln('');
+  if HaveObj then
+    begin
+    AddLn('Destructor %s.Destroy;',[M.TypeName]);
+    Addln('');
+    Addln('begin');
+    Indent;
+    For E in J do
+      begin
+      P:=AddToPath(M.Path,E.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If (IM<>Nil) and (IM.JSONType=jtObject) then
+        AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');');
+      end;
+    Addln('inherited;');
+    Undent;
+    Addln('end;');
+    Addln('');
+    end;
+  Addln('');
+  if jpoUseSetter in Options then
+    For E in J do
+      begin
+      P:=AddToPath(M.Path,E.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If IM=Nil then
+        raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+      FRN:=FieldPrefix+IM.PropertyName;
+      AddLn('Procedure %s.Set%s(AValue : %s);',[M.TypeName,IM.PropertyName,IM.TypeName]);
+      Addln('');
+      Addln('begin');
+      Indent;
+      AddLn('if ('+FieldPrefix+IM.PropertyName+'=AValue) then exit;');
+      If IM.JSONType=jtObject then
+        AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');');
+      AddLn(FieldPrefix+IM.PropertyName+':=AValue;');
+      Undent;
+      Addln('end;');
+      Addln('');
+      end;
+  if jpoGenerateLoad in Options then
+    begin
+    AddLn('Constructor %s.CreateFromJSON(AJSON : %s);',[M.TypeName,JSONDataName]);
+    Addln('');
+    Addln('begin');
+    Indent;
+    AddLn('Create(%s);',[GetObjectConstructorArguments]);
+    AddLn('LoadFromJSON(AJSON);');
+    Undent;
+    Addln('end;');
+    Addln('');
+    if jpoDelphiJSON in options then
+      GenerateLoadJSONDelphi(M,J)
+    else
+      GenerateLoadJSONfpJSON(M,J);
+    end;
+  if jpoGenerateSave in Options then
+    if jpoDelphiJSON in options then
+      GenerateSaveJSONDelphi(M,J)
+    else
+      GenerateSaveJSONfpJSON(M,J);
+end;
+
+procedure TJSONToPascal.GenerateImplementation(const APath: String; J: TJSONData);
+
+Var
+  M ,IM :  TPropertyMapItem;
+  O : TJSONEnum;
+  P : String;
+
+begin
+  Addln('');
+  M:=FPropertyMap.FindPath(APath);
+  if M.SkipType then
+    exit;
+  if J is TJSONArray then
+    GenerateArrayImplementation(M,TJSONarray(J))
+  else if J is TJSONObject then
+    begin
+    For O in TJSONOBject(J) do
+      begin
+      P:=AddToPath(APath,O.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If (O.Value.JSONType in StructuredJSONTypes) then
+        GenerateImplementation(P,O.Value);
+      end;
+    GenerateObjectImplementation(M,TJSONObject(J));
+    end;
+  Addln('');
+end;
+
+procedure TJSONToPascal.GenerateImplementationEnd;
+begin
+  Addln('end.');
+end;
+
+procedure TJSONToPascal.Execute;
+
+Var
+  J : TJSONData;
+  DoFree : Boolean;
+
+begin
+  J:=Nil;
+  DoFree:=False;
+  Factive:=True;
+  try
+    ClearGeneratedTypes;
+    J:=GetJSONData(DoFree);
+    GenerateInterfaceHeader;
+    FInType:=False;
+    GenerateDeclaration('',J);
+    Undent;
+    GenerateImplementationHeader;
+    GenerateImplementation('',J);
+    GenerateImplementationEnd;
+  finally
+    if DoFree then
+      FreeAndNil(J);
+    Factive:=False;
+  end;
+end;
+
+{ TPropertyMapItem }
+
+procedure TPropertyMapItem.Assign(Source: TPersistent);
+
+Var
+  M : TPropertyMapItem;
+
+begin
+  if Source is TPropertyMapItem then
+    begin
+    M:=Source as TPropertyMapItem;
+    FPath:=M.Path;
+    FTypeName:=M.TypeName;
+    FParentTypeName:=M.ParentTypeName;
+    FGenerated:=M.Generated;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+end.
+

+ 171 - 0
compiler/packages/fcl-json/src/json2yaml.pp

@@ -0,0 +1,171 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2017 by Michael Van Canneyt [email protected]
+
+    JSON To YAML syntax converter
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit json2yaml;
+
+{$MODE OBJFPC}
+{$H+}
+
+interface
+
+uses classes,fpjson;
+
+Type
+
+  { TJSONToYaml }
+
+  TJSONToYaml = class
+  Private
+    FAddHeader: Boolean;
+    FIndent : String;
+    FIndentSize: integer;
+    FOutput : TStream;
+    FLineBreak : String;
+    FIndentAdd : String;
+  Protected
+    Function Indent(S :String): Integer;
+    Procedure ConvertNull;
+    Procedure ConvertBoolean(JSON : TJSONBoolean);
+    Procedure ConvertArray(JSON : TJSONArray);
+    procedure ConvertObject(JSON: TJSONObject);
+    Procedure ConvertNumber(JSON : TJSONNumber);
+    Procedure ConvertString(JSON : TJSONString);
+    Procedure DoConvert(JSON : TJSONData);
+    procedure Push(S: TJSONStringType);
+    Property TheOutput : TStream Read Foutput;
+  Public
+    Procedure Convert(JSON : TJSONData; aOutput : TStream);
+    Property AddHeader : Boolean Read FAddHeader Write FAddHeader;
+    Property IndentSize: Integer Read FIndentSize Write FIndentSize;
+  end;
+
+implementation
+
+procedure TJSONToYaml.Push(S : TJSONStringType);
+
+begin
+  if (Findent<>'') then
+    Foutput.WriteBuffer(Findent[1],Length(Findent));
+  S:=S+FLineBreak;
+  Foutput.WriteBuffer(S[1],Length(S));
+  Findent:=StringOfChar(' ',Length(FIndent));
+end;
+
+procedure TJSONToYaml.ConvertNumber(JSON: TJSONNumber);
+
+begin
+  Push(JSON.AsString);
+end;
+
+procedure TJSONToYaml.ConvertString(JSON: TJSONString);
+begin
+  Push(JSON.AsString);
+end;
+
+function TJSONToYaml.Indent(S: String): Integer;
+begin
+  Result:=Length(FIndent);
+  if (S='') then
+    S:=FIndentAdd;
+  Findent:=Findent+S;
+end;
+
+procedure TJSONToYaml.ConvertNull;
+begin
+  Push('null');
+end;
+
+procedure TJSONToYaml.ConvertBoolean(JSON: TJSONBoolean);
+begin
+  If JSON.AsBoolean then
+    Push('true')
+  else
+    Push('false');
+end;
+
+procedure TJSONToYaml.ConvertArray(JSON: TJSONArray);
+
+Var
+  l,i : Integer;
+
+begin
+  L:=Length(Findent);
+  try
+    For I:=0 to JSON.Count-1 do
+      begin
+      Indent('- ');
+      DoConvert(JSON.Items[i]);
+      SetLength(Findent,L);
+      end;
+  finally
+    SetLength(Findent,L);
+  end;
+end;
+
+procedure TJSONToYaml.ConvertObject(JSON: TJSONObject);
+
+Var
+  I,L : Integer;
+  D : TJSONData;
+  N : TJSONStringType;
+
+begin
+  L:=Length(FIndent);
+  try
+    For I:=0 to JSON.Count-1 do
+      begin
+      D:=JSON.Items[I];
+      N:=JSON.Names[I];
+      if D.JSONType in fpjson.StructuredJSONTypes then
+        begin
+        Push(N+': ');
+        Indent('');
+        end
+      else
+        Indent(N+': ');
+      DoConvert(D);
+      SetLength(Findent,L);
+      end
+  finally
+    SetLength(Findent,L);
+  end;
+end;
+
+procedure TJSONToYaml.Convert(JSON: TJSONData; aOutput: TStream);
+
+begin
+  If FIndentSize=0 then
+    FIndentSize:=2;
+  Findent:='';
+  FIndentAdd:=StringOfChar(' ',FIndentSize);
+  FLineBreak:=sLineBreak;
+  FOutput:=AOUtput;
+  if AddHeader then
+    Push('---');
+  DoConvert(JSON);
+end;
+
+procedure TJSONToYaml.DoConvert(JSON: TJSONData);
+begin
+  Case JSON.JSONType of
+    jtArray : convertArray(JSON as TJSONArray);
+    jtObject : convertObject(JSON as TJSONObject);
+    jtString : convertString(JSON as TJSONString);
+    jtNull : ConvertNull;
+    jtNumber : ConvertNumber(JSON as TJSONNumber);
+    jtBoolean : ConvertBoolean(JSON as TJSONBoolean);
+  end;
+end;
+
+end.

+ 796 - 0
compiler/packages/fcl-json/src/jsonconf.pp

@@ -0,0 +1,796 @@
+{
+    This file is part of the Free Component Library
+
+    Implementation of TJSONConfig class
+    Copyright (c) 2007 Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+  TJSONConfig enables applications to use JSON files for storing their
+  configuration data
+}
+
+{$IFDEF FPC}
+{$MODE objfpc}
+{$H+}
+{$ENDIF}
+
+unit jsonConf;
+
+interface
+
+uses
+  SysUtils, Classes, fpjson, jsonscanner, jsonparser;
+
+Const
+  DefaultJSONOptions = [joUTF8,joComments];
+
+type
+  EJSONConfigError = class(Exception);
+
+(* ********************************************************************
+   "APath" is the path and name of a value: A JSON configuration file 
+   is hierachical. "/" is the path delimiter, the part after the last 
+   "/" is the name of the value. The path components will be mapped 
+   to nested JSON objects, with the name equal to the part. In practice 
+   this means that "/my/path/value" will be written as:
+   { 
+     "my" : {
+       "path" : {
+         "value" : Value
+       }
+     }
+   }
+   ******************************************************************** *)
+
+  { TJSONConfig }
+
+  TJSONConfig = class(TComponent)
+  private
+    FFilename: String;
+    FFormatIndentSize: Integer;
+    FFormatoptions: TFormatOptions;
+    FFormatted: Boolean;
+    FJSONOptions: TJSONOptions;
+    FKey: TJSONObject;
+    procedure DoSetFilename(const AFilename: String; ForceReload: Boolean);
+    procedure SetFilename(const AFilename: String);
+    procedure SetJSONOptions(AValue: TJSONOptions);
+    Function StripSlash(Const P : UnicodeString) : UnicodeString;
+  protected
+    FJSON: TJSONObject;
+    FModified: Boolean;
+    Procedure LoadFromFile(Const AFileName : String);
+    Procedure LoadFromStream(S : TStream); virtual;
+    procedure Loaded; override;
+    function FindNodeForValue(const APath: UnicodeString; aExpectedType: TJSONDataClass; out AParent: TJSONObject; out ElName: UnicodeString): TJSONData;
+    function FindPath(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
+    function FindObject(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
+    function FindObject(Const APath: UnicodeString; AllowCreate : Boolean;Out ElName : UnicodeString) : TJSONObject;
+    function FindElement(Const APath: UnicodeString; CreateParent : Boolean; AllowObject : Boolean = False) : TJSONData;
+    function FindElement(Const APath: UnicodeString; CreateParent : Boolean; out AParent : TJSONObject; Out ElName : UnicodeString; AllowObject : Boolean = False) : TJSONData;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    Procedure Reload;
+    procedure Clear;
+    procedure Flush;    // Writes the JSON file
+    procedure OpenKey(const aPath: UnicodeString; AllowCreate : Boolean);
+    procedure CloseKey;
+    procedure ResetKey;
+    Procedure EnumSubKeys(Const APath : UnicodeString; List : TStrings);
+    Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
+
+    function  GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
+    function  GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
+    function  GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
+    function  GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
+    function  GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
+    Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
+    Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
+    procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
+    procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
+    procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
+    procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
+    procedure SetValue(const APath: UnicodeString; AValue: Double); overload;
+    procedure SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False); overload;
+
+    procedure SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString); overload;
+    procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Integer); overload;
+    procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Int64); overload;
+    procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Boolean); overload;
+
+    procedure DeletePath(const APath: UnicodeString);
+    procedure DeleteValue(const APath: UnicodeString);
+    property Modified: Boolean read FModified;
+  published
+    Property Filename: String read FFilename write SetFilename;
+    Property Formatted : Boolean Read FFormatted Write FFormatted;
+    Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
+    Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
+    Property JSONOptions : TJSONOptions Read FJSONOptions Write SetJSONOptions Default DefaultJSONOptions;
+  end;
+
+
+// ===================================================================
+
+implementation
+
+Resourcestring
+  SErrInvalidJSONFile = '"%s" is not a valid JSON configuration file.';
+  SErrCouldNotOpenKey = 'Could not open key "%s".';
+  SErrCannotNotReplaceKey = 'A (sub)key with name "%s" already exists.';
+
+constructor TJSONConfig.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FJSON:=TJSONObject.Create;
+  FKey:=FJSON;
+  FFormatOptions:=DefaultFormat;
+  FFormatIndentsize:=DefaultIndentSize;
+  FJSONOptions:=DefaultJSONOptions;
+end;
+
+destructor TJSONConfig.Destroy;
+begin
+  if Assigned(FJSON) then
+    begin
+    Flush;
+    FreeANdNil(FJSON);
+    end;
+  inherited Destroy;
+end;
+
+procedure TJSONConfig.Clear;
+begin
+  FJSON.Clear;
+  FKey:=FJSON;
+end;
+
+procedure TJSONConfig.Flush;
+
+Var
+  F : TFileStream;
+  S : TJSONStringType;
+  
+begin
+  if Modified then
+    begin
+    F:=TFileStream.Create(FileName,fmCreate);
+    Try
+      if Formatted then
+        S:=FJSON.FormatJSON(Formatoptions,FormatIndentSize)
+      else
+        S:=FJSON.AsJSON;
+      if S>'' then
+        F.WriteBuffer(S[1],Length(S));  
+    Finally
+      F.Free;
+    end;
+    FModified := False;
+    end;
+end;
+
+
+function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean
+  ): TJSONObject;
+
+Var
+  Dummy : UnicodeString;
+
+begin
+  Result:=FindObject(APath,AllowCreate,Dummy);
+end;
+
+function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean;
+  out ElName: UnicodeString): TJSONObject;
+
+Var
+  S,El : UnicodeString;
+  P,I : Integer;
+  T : TJSonObject;
+  
+begin
+//  Writeln('Looking for : ', APath);
+  S:=APath;
+  If Pos('/',S)=1 then
+    Result:=FJSON
+  else
+    Result:=FKey;
+  Repeat
+    P:=Pos('/',S);
+    If (P<>0) then
+      begin
+      // Only real paths, ignore double slash
+      If (P<>1) then
+        begin
+        El:=Copy(S,1,P-1);
+        If (Result.Count=0) then
+          I:=-1
+        else
+          I:=Result.IndexOfName(UTF8Encode(El));
+        If (I=-1) then
+          // No element with this name.
+          begin
+          If AllowCreate then
+            begin
+            // Create new node.
+            T:=Result;
+            Result:=TJSonObject.Create;
+            T.Add(UTF8Encode(El),Result);
+            end
+          else
+            Result:=Nil
+          end
+        else
+          // Node found, check if it is an object
+          begin
+          if (Result.Items[i].JSONtype=jtObject) then
+            Result:=Result.Objects[UTF8Encode(el)]
+          else
+            begin
+//            Writeln(el,' type wrong');
+            If AllowCreate then
+              begin
+//              Writeln('Creating ',el);
+              Result.Delete(I);
+              T:=Result;
+              Result:=TJSonObject.Create;
+              T.Add(UTF8Encode(El),Result);
+              end
+            else
+              Result:=Nil
+            end;
+          end;
+        end;
+      Delete(S,1,P);
+      end;
+  Until (P=0) or (Result=Nil);
+  ElName:=S;
+end;
+
+function TJSONConfig.FindElement(const APath: UnicodeString; CreateParent: Boolean; AllowObject : Boolean = False): TJSONData;
+
+Var
+  O : TJSONObject;
+  ElName : UnicodeString;
+  
+begin
+  Result:=FindElement(APath,CreateParent,O,ElName,AllowObject);
+end;
+
+function TJSONConfig.FindElement(const APath: UnicodeString;
+  CreateParent: Boolean; out AParent: TJSONObject; out ElName: UnicodeString;
+  AllowObject : Boolean = False): TJSONData;
+
+Var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  Aparent:=FindObject(APath,CreateParent,ElName);
+  If Assigned(Aparent) then
+    begin
+//    Writeln('Found parent, looking for element:',elName);
+    I:=AParent.IndexOfName(UTF8Encode(ElName));
+//    Writeln('Element index is',I);
+    If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
+      Result:=AParent.Items[i];
+    end;
+//  Writeln('Find ',aPath,' in "',FJSON.AsJSOn,'" : ',Elname,' : ',Result<>NIl);
+end;
+
+
+function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
+
+var
+  El : TJSONData;
+  
+begin
+  El:=FindElement(StripSlash(APath),False);
+  If Assigned(El) then
+    Result:=El.AsUnicodeString
+  else
+    Result:=ADefault;
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
+var
+  El : TJSONData;
+  
+begin
+  El:=FindElement(StripSlash(APath),False);
+  If Not Assigned(el) then
+    Result:=ADefault
+  else if (el is TJSONNumber) then
+    Result:=El.AsInteger
+  else
+    Result:=StrToIntDef(El.AsString,ADefault);
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
+var
+  El : TJSONData;
+
+begin
+  El:=FindElement(StripSlash(APath),False);
+  If Not Assigned(el) then
+    Result:=ADefault
+  else if (el is TJSONNumber) then
+    Result:=El.AsInt64
+  else
+    Result:=StrToInt64Def(El.AsString,ADefault);
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
+
+var
+  El : TJSONData;
+  
+begin
+  El:=FindElement(StripSlash(APath),False);
+  If Not Assigned(el) then
+    Result:=ADefault
+  else if (el is TJSONBoolean) then
+    Result:=El.AsBoolean
+  else
+    Result:=StrToBoolDef(El.AsString,ADefault);
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
+
+var
+  El : TJSONData;
+
+begin
+  El:=FindElement(StripSlash(APath),False);
+  If Not Assigned(el) then
+    Result:=ADefault
+  else if (el is TJSONNumber) then
+    Result:=El.AsFloat
+  else
+    Result:=StrToFloatDef(El.AsString,ADefault);
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
+  const ADefault: String): Boolean;
+var
+  El : TJSONData;
+  D : TJSONEnum;
+
+begin
+  AValue.Clear;
+  El:=FindElement(StripSlash(APath),False,True);
+  Result:=Assigned(el);
+  If Not Result then
+    begin
+    AValue.Text:=ADefault;
+    exit;
+    end;
+  Case El.JSONType of
+    jtArray:
+      For D in El do
+        if D.Value.JSONType in ActualValueJSONTypes then
+          AValue.Add(D.Value.AsString);
+    jtObject:
+      For D in El do
+        if D.Value.JSONType in ActualValueJSONTypes then
+          AValue.Add(D.Key+'='+D.Value.AsString);
+  else
+    AValue.Text:=EL.AsString
+  end;
+
+end;
+
+function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
+  const ADefault: TStrings): Boolean;
+begin
+  Result:=GetValue(APath,AValue,'');
+  If Not Result then
+    AValue.Assign(ADefault);
+end;
+
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; const AValue: UnicodeString);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+  
+begin
+  El:=FindNodeForValue(aPath,TJSONString,O,elName);
+  If Not Assigned(el) then
+    begin
+    El:=TJSONString.Create(AValue);
+    O.Add(UTF8Encode(ElName),El);
+    end
+  else
+    El.AsUnicodeString:=AValue;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
+begin
+  if AValue = DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath, AValue);
+end;
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Integer);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+
+begin
+  El:=FindNodeForValue(aPath,TJSONIntegerNumber,O,elName);
+  If Not Assigned(el) then
+    begin
+    El:=TJSONIntegerNumber.Create(AValue);
+    O.Add(UTF8Encode(ElName),El);
+    end
+  else
+    El.AsInteger:=AValue;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Int64);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+
+begin
+  El:=FindNodeForValue(aPath,TJSONInt64Number,O,elName);
+  If Not Assigned(el) then
+    begin
+    El:=TJSONInt64Number.Create(AValue);
+    O.Add(UTF8Encode(ElName),El);
+    end
+  else
+    El.AsInt64:=AValue;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
+  DefValue: Integer);
+begin
+  if AValue = DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath, AValue);
+end;
+
+procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
+  DefValue: Int64);
+begin
+  if AValue = DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath, AValue);
+end;
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Boolean);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+
+begin
+  El:=FindNodeForValue(aPath,TJSONBoolean,O,elName);
+  If Not Assigned(el) then
+    begin
+    El:=TJSONBoolean.Create(AValue);
+    O.Add(UTF8Encode(ElName),El);
+    end
+  else
+    El.AsBoolean:=AValue;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Double);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+
+begin
+  El:=FindNodeForValue(aPath,TJSONFloatNumber,O,elName);
+  If Not Assigned(el) then
+    begin
+    El:=TJSONFloatNumber.Create(AValue);
+    O.Add(UTF8Encode(ElName),El);
+    end
+  else
+    El.AsFloat:=AValue;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False);
+
+var
+  El : TJSONData;
+  ElName : UnicodeString;
+  O : TJSONObject;
+  I : integer;
+  A : TJSONArray;
+  N,V : String;
+
+begin
+  if AsObject then
+    El:=FindNodeForValue(aPath,TJSONObject,O,elName)
+  else
+    El:=FindNodeForValue(aPath,TJSONArray,O,elName);
+  If Not Assigned(el) then
+    begin
+    if AsObject then
+      El:=TJSONObject.Create
+    else
+      El:=TJSONArray.Create;
+    O.Add(UTF8Encode(ElName),El);
+    end;
+  if Not AsObject then
+    begin
+    A:=El as TJSONArray;
+    A.Clear;
+    For N in Avalue do
+      A.Add(N);
+    end
+  else
+    begin
+    O:=El as TJSONObject;
+    For I:=0 to AValue.Count-1 do
+      begin
+      AValue.GetNameValue(I,N,V);
+      O.Add(N,V);
+      end;
+    end;
+  FModified:=True;
+end;
+
+procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
+  DefValue: Boolean);
+begin
+  if AValue = DefValue then
+    DeleteValue(APath)
+  else
+    SetValue(APath,AValue);
+end;
+
+procedure TJSONConfig.DeletePath(const APath: UnicodeString);
+
+Var
+  P : UnicodeString;
+  L : integer;
+  Node : TJSONObject;
+  ElName : UnicodeString;
+  
+begin
+  P:=StripSlash(APath);
+  L:=Length(P);
+  If (L>0) then
+    begin
+    Node := FindObject(P,False,ElName);
+    If Assigned(Node) then
+      begin
+      L:=Node.IndexOfName(UTF8Encode(ElName));
+      If (L<>-1) then
+        Node.Delete(L);
+      end;
+    end;
+  FModified:=True;  
+end;
+
+procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
+
+begin
+  DeletePath(APath);
+end;
+
+procedure TJSONConfig.Reload;
+
+begin
+  if Length(Filename) > 0 then
+    DoSetFilename(Filename,True);
+end;
+
+procedure TJSONConfig.Loaded;
+begin
+  inherited Loaded;
+  Reload;
+end;
+
+function TJSONConfig.FindNodeForValue(const APath: UnicodeString; aExpectedType : TJSONDataClass; out AParent: TJSONObject; out ElName: UnicodeString): TJSONData;
+
+var
+  I : Integer;
+
+begin
+  Result:=FindElement(StripSlash(APath),True,aParent,ElName,True);
+  if Assigned(Result) and Not Result.InheritsFrom(aExpectedType) then
+    begin
+    I:=aParent.IndexOfName(UTF8Encode(elName));
+    aParent.Delete(i);
+    Result:=Nil;
+    end;
+end;
+
+function TJSONConfig.FindPath(const APath: UnicodeString; AllowCreate: Boolean
+  ): TJSONObject;
+  
+Var
+  P : UnicodeString;
+  L : Integer;
+  
+begin
+  P:=APath;
+  L:=Length(P);
+  If (L=0) or (P[L]<>'/') then
+    P:=P+'/';
+  Result:=FindObject(P,AllowCreate);
+end;
+
+procedure TJSONConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean);
+
+begin
+  if (not ForceReload) and (FFilename = AFilename) then
+    exit;
+  FFilename := AFilename;
+
+  if csLoading in ComponentState then
+    exit;
+  Flush;
+  If Not FileExists(AFileName) then
+    Clear
+  else
+    LoadFromFile(AFileName);
+end;
+
+procedure TJSONConfig.SetFilename(const AFilename: String);
+begin
+  DoSetFilename(AFilename, False);
+end;
+
+procedure TJSONConfig.SetJSONOptions(AValue: TJSONOptions);
+begin
+  if FJSONOptions=AValue then Exit;
+  FJSONOptions:=AValue;
+  if csLoading in ComponentState then
+    exit;
+  if (FFileName<>'') then
+    Reload;
+end;
+
+function TJSONConfig.StripSlash(const P: UnicodeString): UnicodeString;
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(P);
+  If (L>0) and (P[l]='/') then
+    Result:=Copy(P,1,L-1)
+  else
+    Result:=P;
+end;
+
+procedure TJSONConfig.LoadFromFile(const AFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmopenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TJSONConfig.LoadFromStream(S: TStream);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S,FJSONOptions);
+  try
+    J:=P.Parse;
+    If (J is TJSONObject) then
+      begin
+      FreeAndNil(FJSON);
+      FJSON:=J as TJSONObject;
+      FKey:=FJSON;
+      end
+    else
+      begin
+      FreeAndNil(J);
+      Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[FileName]);
+      end;
+  finally
+    P.Free;
+  end;
+end;
+
+
+procedure TJSONConfig.CloseKey;
+begin
+  ResetKey;
+end;
+
+procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
+
+Var
+  P : UnicodeString;
+  L : Integer;
+  
+begin
+  P:=APath;
+  L:=Length(P);
+  If (L=0) then
+    FKey:=FJSON
+  else
+    begin
+    if (P[L]<>'/') then
+      P:=P+'/';
+    FKey:=FindObject(P,AllowCreate);
+    If (FKey=Nil) Then
+      Raise EJSONConfigError.CreateFmt(SErrCouldNotOpenKey,[APath]);
+    end;
+end;
+
+procedure TJSONConfig.ResetKey;
+begin
+  FKey:=FJSON;
+end;
+
+procedure TJSONConfig.EnumSubKeys(const APath: UnicodeString; List: TStrings);
+
+Var
+  AKey : TJSONObject;
+  I : Integer;
+  
+begin
+  AKey:=FindPath(APath,False);
+  If Assigned(AKey) then
+    begin
+    For I:=0 to AKey.Count-1 do
+      If AKey.Items[i] is TJSONObject then
+        List.Add(AKey.Names[i]);
+    end;
+end;
+
+procedure TJSONConfig.EnumValues(const APath: UnicodeString; List: TStrings);
+
+Var
+  AKey : TJSONObject;
+  I : Integer;
+
+begin
+  AKey:=FindPath(APath,False);
+  If Assigned(AKey) then
+    begin
+    For I:=0 to AKey.Count-1 do
+      If Not (AKey.Items[i] is TJSONObject) then
+        List.Add(AKey.Names[i]);
+    end;
+end;
+
+
+end.

+ 548 - 0
compiler/packages/fcl-json/src/jsonini.pp

@@ -0,0 +1,548 @@
+unit jsonini;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+uses
+  Classes, SysUtils, inifiles, fpjson, jsonscanner, jsonparser, dateutils;
+
+type
+
+  { TJSONIniFile }
+
+  TJSONIniFile = class(TCustomIniFile)
+  Private
+    FJSON: TJSONObject;
+    FCacheUpdates: Boolean;
+    FDirty : Boolean;
+    FStream: TStream;
+    procedure SetCacheUpdates(const AValue: Boolean);
+  protected
+    Function GetRoot : TJSONObject;
+    Function GetSection(Const ASectionName : String; AllowCreate : Boolean) : TJSONObject;
+    Function GetKeyData(Const ASectionName,AKeyName : String) : TJSONData;
+    // Return true if an existing item was replaced
+    Function SetKeyData(Const ASectionName,AKeyName : String; AData : TJSONData) : Boolean;
+    procedure MaybeUpdateFile;
+    property Dirty : Boolean Read FDirty;
+  public
+    constructor Create(const AFileName: string; AOptions : TIniFileOptions = []); override; overload;
+    constructor Create(AStream: TStream; AOptions : TJSONOptions); overload;
+    destructor Destroy; override;
+    Class Procedure ConvertIni(Const AIniFile,AJSONFile : String; StringsOnly : Boolean = True);
+    function ReadString(const Section, Ident, Default: string): string; override;
+    function ReadInteger(const Section, Ident: string; Default: Longint): Longint; override;
+    function ReadInt64(const Section, Ident: string; Default: Int64): Int64; override;
+    function ReadBool(const Section, Ident: string; Default: Boolean): Boolean; override;
+    function ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime; override;
+    function ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime; override;
+    function ReadFloat(const Section, Ident: string; Default: Double): Double; override;
+    function ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime; override;
+    procedure WriteString(const Section, Ident, Value: String); override;
+    procedure WriteDate(const Section, Ident: string; Value: TDateTime); override;
+    procedure WriteDateTime(const Section, Ident: string; Value: TDateTime); override;
+    procedure WriteFloat(const Section, Ident: string; Value: Double); override;
+    procedure WriteTime(const Section, Ident: string; Value: TDateTime); override;
+    procedure WriteInteger(const Section, Ident: string; Value: Longint); override;
+    procedure WriteInt64(const Section, Ident: string; Value: Int64); override;
+    procedure WriteBool(const Section, Ident: string; Value: Boolean); override;
+    procedure ReadSection(const Section: string; Strings: TStrings); override;
+    procedure ReadSections(Strings: TStrings); override;
+    procedure ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = [svoIncludeInvalid]); overload; override;
+    procedure EraseSection(const Section: string); override;
+    procedure DeleteKey(const Section, Ident: String); override;
+    procedure UpdateFile; override; overload;
+    procedure UpdateFile(Const AFileName : string); overload;
+    property Stream: TStream read FStream;
+    property CacheUpdates : Boolean read FCacheUpdates write SetCacheUpdates;
+  end;
+
+implementation
+
+{ TJSONIniFile }
+
+procedure TJSONIniFile.SetCacheUpdates(const AValue: Boolean);
+begin
+  if FCacheUpdates and not AValue and FDirty then
+    UpdateFile;
+end;
+
+function TJSONIniFile.GetRoot: TJSONObject;
+begin
+  Result:=FJSON;
+end;
+
+function TJSONIniFile.GetSection(const ASectionName: String; AllowCreate: Boolean): TJSONObject;
+
+Var
+  I : Integer;
+  R : TJSONObject;
+
+begin
+  Result:=Nil;
+  R:=GetRoot;
+  I:=R.IndexOfName(ASectionName,True);
+  if (I<>-1) and (R.Items[i].JSONType=jtObject) then
+    Result:=R.Items[i] as TJSONObject
+  else if AllowCreate then
+    begin
+    if (I<>-1) then
+      R.Delete(I);
+    Result:=TJSONObject.Create;
+    R.Add(ASectionName,Result);
+    end;
+end;
+
+function TJSONIniFile.GetKeyData(const ASectionName, AKeyName: String): TJSONData;
+
+Var
+  O : TJSONObject;
+  I : integer;
+
+begin
+  Result:=Nil;
+  O:=GetSection(ASectionName,False);
+  if Assigned(O) then
+    begin
+    I:=O.IndexOfName(AKeyName,True);
+    if (I<>-1) and (O.Items[i].JSONType in ActualValueJSONTypes) then
+      Result:=O.Items[i];
+    end
+end;
+
+function TJSONIniFile.SetKeyData(const ASectionName, AKeyName: String; AData: TJSONData): Boolean;
+Var
+  O : TJSONObject;
+  I : integer;
+
+begin
+  O:=GetSection(ASectionName,true);
+  I:=O.IndexOfName(AKeyName,True);
+  Result:=(I<>-1);
+  if Result then
+    O.Delete(I);
+  O.Add(aKeyName,AData);
+  FDirty:=True;
+end;
+
+procedure TJSONIniFile.MaybeUpdateFile;
+begin
+  If FCacheUpdates then
+    FDirty:=True
+  else
+    UpdateFile;
+end;
+
+constructor TJSONIniFile.Create(const AFileName: string; AOptions : TIniFileOptions = []);
+
+Var
+  F : TFileStream;
+
+begin
+  Inherited Create(AFileName,AOptions);
+  if Not FileExists(AFileName) then
+    FJSON:=TJSONObject.Create
+  else
+    begin
+    F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+    try
+      Create(F,[joUTF8,joComments,joIgnoreTrailingComma]);
+    finally
+      F.Free;
+    end;
+    end;
+end;
+
+constructor TJSONIniFile.Create(AStream: TStream; AOptions: TJSONOptions);
+
+Var
+  P : TJSONParser;
+  D : TJSONData;
+
+begin
+  D:=Nil;
+  P:=TJSONParser.Create(AStream,AOptions);
+  try
+    D:=P.Parse;
+    if (D is TJSONObject) then
+      begin
+      FJSON:=D as TJSONObject;
+      D:=Nil;
+      end
+    else
+      FJSON:=TJSONObject.Create;
+  finally
+    D.Free;
+    P.Free;
+  end;
+end;
+
+destructor TJSONIniFile.Destroy;
+begin
+  FreeAndNil(FJSON);
+  inherited Destroy;
+end;
+
+class procedure TJSONIniFile.ConvertIni(const AIniFile, AJSONFile: String; StringsOnly: Boolean = true);
+
+Var
+  SIni : TMemIniFile;
+  Dini : TJSONIniFile;
+  S,K : TStrings;
+  SN,KN,V : String;
+  I6 : Int64;
+  F : Double;
+  B : Boolean;
+  DT : TDateTime;
+
+begin
+  S:=Nil;
+  K:=Nil;
+  Dini:=Nil;
+  SIni:=TMemIniFile.Create(AIniFile);
+  try
+    DIni:=Self.Create(AJSONFile);
+    S:=TStringList.Create;
+    K:=TStringList.Create;
+    SIni.ReadSections(S);
+    For SN in S do
+      begin
+      SIni.ReadSection(SN,K);
+      For KN in K do
+        begin
+        V:=Sini.ReadString(SN,KN,'');
+        if StringsOnly then
+          Dini.WriteString(SN,KN,V)
+        else
+          begin
+          If TryStrToInt64(V,I6) then
+            Dini.WriteInt64(SN,KN,I6)
+          else If TryStrToFloat(V,F) then
+            Dini.WriteFloat(SN,KN,F)
+          else If TryStrToBool(V,B) then
+            Dini.WriteBool(SN,KN,B)
+          else
+            begin
+            DT:=SIni.ReadTime(SN,KN,-1);
+            B:=DT<>-1;
+            if B then
+              DIni.WriteTime(SN,KN,DT)
+            else
+              begin
+              DT:=SIni.ReadDate(SN,KN,0);
+              B:=DT<>0;
+              if B then
+                DIni.WriteDate(SN,KN,DT)
+              else
+                begin
+                DT:=SIni.ReadDateTime(SN,KN,0);
+                B:=DT<>0;
+                if B then
+                  DIni.WriteDateTime(SN,KN,DT)
+                end;
+              end;
+            if Not B then
+              Dini.WriteString(SN,KN,V)
+            end;
+          end;
+        end;
+      end;
+    Dini.UpdateFile;
+  finally
+    FreeAndNil(S);
+    FreeAndNil(K);
+    FreeAndNil(Dini);
+    FreeAndNil(Sini);
+  end;
+end;
+
+function TJSONIniFile.ReadString(const Section, Ident, Default: string): string;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else
+    begin
+    if D.JSONType in StructuredJSONTypes then
+      Result:=D.AsJSON
+    else
+      Result:=D.AsString;
+    end
+end;
+
+function TJSONIniFile.ReadInteger(const Section, Ident: string; Default: Longint): Longint;
+
+Var
+  D : TJSONData;
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else
+    if D.JSONType=jtNumber then
+      Result:=D.AsInteger
+    else
+      if not TryStrToInt(D.AsString,Result) then
+        Result:=Default;
+end;
+
+function TJSONIniFile.ReadInt64(const Section, Ident: string; Default: Int64): Int64;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else
+    if D.JSONType=jtNumber then
+      Result:=D.AsInt64
+    else
+      if not TryStrToInt64(D.AsString,Result) then
+        Result:=Default;
+end;
+
+function TJSONIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else
+    // Avoid exception frame
+    if D.JSONType=jtBoolean then
+      Result:=D.AsBoolean
+    else
+      try
+        Result:=D.AsBoolean;
+      except
+        Result:=Default;
+      end;
+end;
+
+function TJSONIniFile.ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else if D.JSONType=jtNumber then
+    Result:=TDateTime(D.AsFloat)
+  else
+    Result:=ScanDateTime('yyyy"-"mm"-"dd',D.AsString);
+end;
+
+function TJSONIniFile.ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime;
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else if D.JSONType=jtNumber then
+    Result:=TDateTime(D.AsFloat)
+  else
+    Result:=ScanDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz',D.AsString);
+end;
+
+function TJSONIniFile.ReadFloat(const Section, Ident: string; Default: Double): Double;
+Var
+  D : TJSONData;
+  C : Integer;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else
+    if D.JSONType=jtNumber then
+      Result:=D.AsFloat
+    else
+      // Localized
+      if not TryStrToFloat(D.AsString,Result) then
+        begin
+        // Not localized
+        Val(D.AsString,Result,C);
+        if (C<>0) then
+          Result:=Default;
+        end;
+end;
+
+function TJSONIniFile.ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetKeyData(Section,Ident);
+  if Not Assigned(D) then
+    Result:=Default
+  else if D.JSONType=jtNumber then
+    Result:=Frac(TDateTime(D.AsFloat))
+  else
+    Result:=ScanDateTime('"0000-00-00T"hh":"nn":"ss"."zzz',D.AsString);
+end;
+
+procedure TJSONIniFile.WriteString(const Section, Ident, Value: String);
+begin
+  SetKeyData(Section,Ident,CreateJSON(Value));
+end;
+
+procedure TJSONIniFile.WriteDate(const Section, Ident: string; Value: TDateTime);
+begin
+  SetKeyData(Section,Ident,CreateJSON(FormatDateTime('yyyy"-"mm"-"dd"T"00":"00":"00.zzz',Value)));
+end;
+
+procedure TJSONIniFile.WriteDateTime(const Section, Ident: string; Value: TDateTime);
+begin
+  SetKeyData(Section,Ident,CreateJSON(FormatDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss.zzz',Value)));
+end;
+
+procedure TJSONIniFile.WriteFloat(const Section, Ident: string; Value: Double);
+begin
+  SetKeyData(Section,Ident,CreateJSON(Value));
+end;
+
+procedure TJSONIniFile.WriteTime(const Section, Ident: string; Value: TDateTime);
+begin
+  SetKeyData(Section,Ident,CreateJSON(FormatDateTime('0000"-"00"-"00"T"hh":"nn":"ss.zzz',Value)));
+end;
+
+procedure TJSONIniFile.WriteInteger(const Section, Ident: string; Value: Longint);
+begin
+  SetKeyData(Section,Ident,CreateJSON(Value));
+end;
+
+procedure TJSONIniFile.WriteInt64(const Section, Ident: string; Value: Int64);
+begin
+  SetKeyData(Section,Ident,CreateJSON(Value));
+end;
+
+procedure TJSONIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
+begin
+  SetKeyData(Section,Ident,CreateJSON(Value));
+end;
+
+procedure TJSONIniFile.ReadSection(const Section: string; Strings: TStrings);
+Var
+  O : TJSONObject;
+  E : TJSONEnum;
+
+begin
+  O:=GetSection(Section,False);
+  if Assigned(O) then
+    For E in O do
+      If (E.Value.JSONType in ActualValueJSONTypes) then
+        Strings.Add(E.Key);
+end;
+
+procedure TJSONIniFile.ReadSections(Strings: TStrings);
+
+Var
+  R : TJSONObject;
+  E : TJSONEnum;
+
+begin
+  R:=GetRoot;
+  for E in R do
+    if E.Value.JSONType=jtObject then
+      Strings.Add(E.Key);
+end;
+
+procedure TJSONIniFile.ReadSectionValues(const Section: string; Strings: TStrings; AOptions: TSectionValuesOptions);
+
+Var
+  O : TJSONObject;
+  E : TJSONEnum;
+  V : TJSONStringType;
+
+begin
+  O:=GetSection(Section,False);
+  if Assigned(O) then
+    For E in O do
+      begin
+      If (E.Value.JSONType in ActualValueJSONTypes) then
+        begin
+        V:=E.Value.AsString;
+        Strings.Add(E.Key+'='+V);
+        end
+      else if (svoIncludeInvalid in AOptions) then
+        begin
+        V:=E.Value.AsJSON;
+        Strings.Add(E.Key+'='+V);
+        end
+      end;
+end;
+
+procedure TJSONIniFile.EraseSection(const Section: string);
+
+Var
+  I : Integer;
+
+begin
+  I:=GetRoot.IndexOfName(Section,True);
+  if (I<>-1) then
+    begin
+    GetRoot.Delete(I);
+    MaybeUpdateFile;
+    end;
+end;
+
+procedure TJSONIniFile.DeleteKey(const Section, Ident: String);
+
+Var
+  O : TJSONObject;
+  I : integer;
+
+begin
+  O:=GetSection(Section,False);
+  if O<>Nil then
+    begin
+    I:=O.IndexOfName(Ident,True);
+    if I<>-1 then
+      begin
+      O.Delete(I);
+      MaybeUpdateFile;
+      end;
+    end;
+end;
+
+procedure TJSONIniFile.UpdateFile;
+
+
+begin
+  If (FileName<>'') then
+    UpdateFile(FileName)
+end;
+
+procedure TJSONIniFile.UpdateFile(const AFileName: string);
+
+Var
+  S : TJSONStringType;
+
+begin
+  With TFileStream.Create(AFileName,fmCreate) do
+    try
+      S:=FJSON.FormatJSON();
+      WriteBuffer(S[1],Length(S));
+    finally
+      Free;
+    end;
+end;
+
+end.
+

+ 241 - 0
compiler/packages/fcl-json/src/jsonparser.pp

@@ -0,0 +1,241 @@
+{
+    This file is part of the Free Component Library
+
+    JSON source parser
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit jsonparser;
+
+interface
+
+uses
+  Classes, SysUtils, fpJSON, jsonscanner, jsonreader;
+  
+Type
+
+  { TJSONParser }
+
+  TJSONParser = Class(TBaseJSONReader)
+  private
+    FStack : Array of TJSONData;
+    FStackPos : integer;
+    FStruct : TJSONData;
+    FValue : TJSONData;
+    FKey: TJSONStringType;
+    procedure Pop(aType: TJSONType);
+    Procedure Push(AValue : TJSONData);
+    Function NewValue(AValue : TJSONData) : TJSONData;
+  Protected
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
+  Public
+    function Parse: TJSONData;
+  end;
+  
+  EJSONParser = jsonReader.EJSONParser;
+  
+implementation
+
+Resourcestring
+  SErrStructure = 'Structural error';
+
+{ TJSONParser }
+
+procedure DefJSONParserHandler(AStream: TStream; const AUseUTF8: Boolean; out
+  Data: TJSONData);
+
+Var
+  P : TJSONParser;
+  AOptions: TJSONOptions;
+
+begin
+  Data:=Nil;
+  AOptions:=[];
+  if AUseUTF8 then
+    Include(AOptions,joUTF8);
+  P:=TJSONParser.Create(AStream,AOptions);
+  try
+    Data:=P.Parse;
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TJSONParser.Pop(aType: TJSONType);
+
+begin
+  if (FStackPos=0) then
+    DoError(SErrStructure);
+  If (FStruct.JSONType<>aType) then
+    DoError(SErrStructure);
+  Dec(FStackPos);
+  FStruct:=FStack[FStackPos];
+end;
+
+procedure TJSONParser.Push(AValue: TJSONData);
+
+begin
+  if (FStackPos=Length(FStack)) then
+    SetLength(FStack,FStackPos+10);
+  FStack[FStackPos]:=FStruct;
+  Inc(FStackPos);
+  FStruct:=AValue;
+end;
+
+function TJSONParser.NewValue(AValue: TJSONData): TJSONData;
+begin
+  Result:=AValue;
+  // Add to existing structural type
+  if (FStruct is TJSONObject) then
+    begin
+    TJSONObject(FStruct).Add(FKey,AValue);
+    FKey:='';
+    end
+  else if (FStruct is TJSONArray) then
+    TJSONArray(FStruct).Add(AValue);
+  // The first actual value is our result
+  if (FValue=Nil) then
+    FValue:=AValue;
+end;
+
+procedure TJSONParser.KeyValue(const AKey: TJSONStringType);
+begin
+  if (FStruct is TJSONObject) and (FKey='') then
+    FKey:=Akey
+  else
+    DoError('Duplicatekey or no object');
+end;
+
+procedure TJSONParser.StringValue(const AValue: TJSONStringType);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.NullValue;
+begin
+  NewValue(CreateJSON);
+end;
+
+procedure TJSONParser.FloatValue(const AValue: Double);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.BooleanValue(const AValue: Boolean);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.NumberValue(const AValue: TJSONStringType);
+begin
+  // Do nothing
+  if AValue='' then ;
+end;
+
+procedure TJSONParser.IntegerValue(const AValue: integer);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.Int64Value(const AValue: int64);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.QWordValue(const AValue: QWord);
+begin
+  NewValue(CreateJSON(AValue));
+end;
+
+procedure TJSONParser.StartArray;
+begin
+  Push(NewValue(CreateJSONArray([])))
+end;
+
+
+procedure TJSONParser.StartObject;
+begin
+  Push(NewValue(CreateJSONObject([])));
+end;
+
+procedure TJSONParser.EndArray;
+begin
+  Pop(jtArray);
+end;
+
+procedure TJSONParser.EndObject;
+begin
+  Pop(jtObject);
+end;
+
+
+function TJSONParser.Parse: TJSONData;
+
+begin
+  SetLength(FStack,0);
+  FStackPos:=0;
+  FValue:=Nil;
+  FStruct:=Nil;
+  try
+    DoExecute;
+    Result:=FValue;
+  except
+    On E : exception do
+      begin
+      FreeAndNil(FValue);
+      FStackPos:=0;
+      SetLength(FStack,0);
+      Raise;
+      end;
+  end;
+end;
+
+{
+  Consume next token and convert to JSON data structure.
+  If AtCurrent is true, the current token is used. If false,
+  a token is gotten from the scanner.
+  If AllowEOF is false, encountering a tkEOF will result in an exception.
+}
+
+
+Procedure InitJSONHandler;
+
+begin
+  if GetJSONParserHandler=Nil then
+    SetJSONParserHandler(@DefJSONParserHandler);
+end;
+
+Procedure DoneJSONHandler;
+
+begin
+  if GetJSONParserHandler=@DefJSONParserHandler then
+    SetJSONParserHandler(Nil);
+end;
+
+initialization
+  InitJSONHandler;
+finalization
+  DoneJSONHandler;
+end.
+

+ 616 - 0
compiler/packages/fcl-json/src/jsonreader.pp

@@ -0,0 +1,616 @@
+{
+    This file is part of the Free Component Library
+
+    JSON SAX-like Reader
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit jsonreader;
+
+interface
+
+uses
+  Classes, SysUtils, fpJSON, jsonscanner;
+  
+Type
+
+  { TBaseJSONReader }
+
+  TBaseJSONReader = Class(TObject)
+  Private
+    FScanner : TJSONScanner;
+    function GetO(AIndex: TJSONOption): Boolean;
+    function GetOptions: TJSONOptions; inline;
+    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
+    procedure SetOptions(AValue: TJSONOptions);
+  Protected
+    procedure DoError(const Msg: String);
+    Procedure DoParse(AtCurrent,AllowEOF: Boolean);
+    function GetNextToken: TJSONToken;
+    function CurrentTokenString: String;
+    function CurrentToken: TJSONToken; inline;
+
+    Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
+    Procedure StringValue(Const AValue : TJSONStringType);virtual; abstract;
+    Procedure NullValue; virtual; abstract;
+    Procedure FloatValue(Const AValue : Double); virtual; abstract;
+    Procedure BooleanValue(Const AValue : Boolean); virtual; abstract;
+    Procedure NumberValue(Const AValue : TJSONStringType); virtual; abstract;
+    Procedure IntegerValue(Const AValue : integer); virtual; abstract;
+    Procedure Int64Value(Const AValue : int64); virtual; abstract;
+    Procedure QWordValue(Const AValue : QWord); virtual; abstract;
+    Procedure StartArray; virtual; abstract;
+    Procedure StartObject; virtual; abstract;
+    Procedure EndArray; virtual; abstract;
+    Procedure EndObject; virtual; abstract;
+
+    Procedure ParseArray;
+    Procedure ParseObject;
+    Procedure ParseNumber;
+    Procedure DoExecute;
+    Property Scanner : TJSONScanner read FScanner;
+  Public
+    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
+    destructor Destroy();override;
+    // Parsing options
+    Property Options : TJSONOptions Read GetOptions Write SetOptions;
+  end;
+
+  TOnJSONBoolean = Procedure (Sender : TObject; Const AValue : Boolean) of object;
+  TOnJSONFloat = Procedure (Sender : TObject; Const AValue : TJSONFloat) of object;
+  TOnJSONInt64 = Procedure (Sender : TObject; Const AValue : Int64) of object;
+  TOnJSONQWord = Procedure (Sender : TObject; Const AValue : QWord) of object;
+  TOnJSONInteger = Procedure (Sender : TObject; Const AValue : Integer) of object;
+  TOnJSONString = Procedure (Sender : TObject; Const AValue : TJSONStringType) of Object;
+  TOnJSONKey = Procedure (Sender : TObject; Const AKey : TJSONStringType) of Object;
+
+
+  { TJSONEventReader }
+
+  TJSONEventReader = Class(TBaseJSONReader)
+  Private
+    FOnBooleanValue: TOnJSONBoolean;
+    FOnEndArray: TNotifyEvent;
+    FOnEndObject: TNotifyEvent;
+    FOnFloatValue: TOnJSONFloat;
+    FOnInt64Value: TOnJSONInt64;
+    FOnIntegerValue: TOnJSONInteger;
+    FOnKeyName: TOnJSONKey;
+    FOnNullValue: TNotifyEvent;
+    FOnNumberValue: TOnJSONString;
+    FOnQWordValue: TOnJSONQWord;
+    FOnStartArray: TNotifyEvent;
+    FOnStartObject: TNotifyEvent;
+    FOnStringValue: TOnJSONString;
+  Protected
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
+  Public
+    Procedure Execute;
+    Property OnNullValue : TNotifyEvent Read FOnNullValue Write FOnNullValue;
+    Property OnBooleanValue : TOnJSONBoolean Read FOnBooleanValue Write FOnBooleanValue;
+    Property OnNumberValue : TOnJSONString Read FOnNumberValue Write FOnNumberValue;
+    Property OnFloatValue : TOnJSONFloat Read FOnFloatValue Write FOnFloatValue;
+    Property OnIntegerValue : TOnJSONInteger Read FOnIntegerValue Write FOnIntegerValue;
+    Property OnInt64Value : TOnJSONInt64 Read FOnInt64Value Write FOnInt64Value;
+    Property OnQWordValue : TOnJSONQWord Read FOnQWordValue Write FOnQWordValue;
+    Property OnStringValue : TOnJSONString Read FOnStringValue Write FOnStringValue;
+    Property OnKeyName : TOnJSONKey Read FOnKeyName Write FOnKeyName;
+    Property OnStartObject : TNotifyEvent Read FOnStartObject Write FOnStartObject;
+    Property OnEndObject : TNotifyEvent Read FOnEndObject Write FOnEndObject;
+    Property OnStartArray : TNotifyEvent Read FOnStartArray Write FOnStartArray;
+    Property OnEndArray : TNotifyEvent Read FOnEndArray Write FOnEndArray;
+  end;
+
+  IJSONConsumer = Interface ['{60F9D640-2A69-4AAB-8EE1-0DB6DC614D27}']
+    Procedure NullValue;
+    Procedure BooleanValue (const AValue : Boolean);
+    Procedure NumberValue (const AValue : TJSONStringType);
+    Procedure FloatValue (const AValue : TJSONFloat);
+    Procedure Int64Value (const AValue : Int64);
+    Procedure QWordValue (const AValue : QWord);
+    Procedure IntegerValue(const AValue : Integer) ;
+    Procedure StringValue(const AValue : TJSONStringType) ;
+    Procedure KeyName(const AKey : TJSONStringType);
+    Procedure StartObject;
+    Procedure EndObject;
+    Procedure StartArray;
+    Procedure EndArray;
+  end;
+
+  { TJSONConsumerReader }
+
+  TJSONConsumerReader = Class(TBaseJSONReader)
+  Private
+    FConsumer: IJSONConsumer;
+  Protected
+    Procedure KeyValue(Const AKey : TJSONStringType); override;
+    Procedure StringValue(Const AValue : TJSONStringType);override;
+    Procedure NullValue; override;
+    Procedure FloatValue(Const AValue : Double); override;
+    Procedure BooleanValue(Const AValue : Boolean); override;
+    Procedure NumberValue(Const AValue : TJSONStringType); override;
+    Procedure IntegerValue(Const AValue : integer); override;
+    Procedure Int64Value(Const AValue : int64); override;
+    Procedure QWordValue(Const AValue : QWord); override;
+    Procedure StartArray; override;
+    Procedure StartObject; override;
+    Procedure EndArray; override;
+    Procedure EndObject; override;
+  Public
+    Procedure Execute;
+    Property Consumer : IJSONConsumer Read FConsumer Write FConsumer;
+  end;
+
+  EJSONParser = Class(EParserError);
+  
+implementation
+
+Resourcestring
+  SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
+  SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
+  SErrExpectedColon   = 'Expected colon (:), got token "%s".';
+  //SErrEmptyElement = 'Empty element encountered.';
+  SErrExpectedElementName    = 'Expected element name, got token "%s"';
+  SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
+  SErrInvalidNumber          = 'Number is not an integer or real number: %s';
+  SErrNoScanner = 'No scanner. No source specified ?';
+  
+{ TBaseJSONReader }
+
+
+Procedure TBaseJSONReader.DoExecute;
+
+begin
+  if (FScanner=Nil) then
+    DoError(SErrNoScanner);
+  DoParse(False,True);
+end;
+
+{
+  Consume next token and convert to JSON data structure.
+  If AtCurrent is true, the current token is used. If false,
+  a token is gotten from the scanner.
+  If AllowEOF is false, encountering a tkEOF will result in an exception.
+}
+
+function TBaseJSONReader.CurrentToken: TJSONToken;
+
+begin
+  Result:=FScanner.CurToken;
+end;
+
+function TBaseJSONReader.CurrentTokenString: String;
+
+begin
+  If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
+    Result:=FScanner.CurTokenString
+  else
+    Result:=TokenInfos[CurrentToken];
+end;
+
+procedure TBaseJSONReader.DoParse(AtCurrent, AllowEOF: Boolean);
+
+var
+  T : TJSONToken;
+  
+begin
+  If not AtCurrent then
+    T:=GetNextToken
+  else
+    T:=FScanner.CurToken;
+  Case T of
+    tkEof : If Not AllowEof then
+              DoError(SErrUnexpectedEOF);
+    tkNull  : NullValue;
+    tkTrue,
+    tkFalse : BooleanValue(t=tkTrue);
+    tkString : if (joUTF8 in Options) and (DefaultSystemCodePage<>CP_UTF8) then
+                 StringValue(TJSONStringType(UTF8Decode(CurrentTokenString)))
+               else
+                 StringValue(CurrentTokenString);
+    tkCurlyBraceOpen :
+        ParseObject;
+    tkCurlyBraceClose :
+        DoError(SErrUnexpectedToken);
+    tkSQuaredBraceOpen :
+        ParseArray;
+    tkSQuaredBraceClose :
+        DoError(SErrUnexpectedToken);
+    tkNumber :
+        ParseNumber;
+    tkComma :
+        DoError(SErrUnexpectedToken);
+    tkIdentifier :
+        DoError(SErrUnexpectedToken);
+  end;
+end;
+
+
+// Creates the correct JSON number type, based on the current token.
+procedure TBaseJSONReader.ParseNumber;
+
+Var
+  I : Integer;
+  I64 : Int64;
+  QW  : QWord;
+  F : TJSONFloat;
+  S : String;
+
+begin
+  S:=CurrentTokenString;
+  NumberValue(S);
+  I:=0;
+  if TryStrToQWord(S,QW) then
+    begin
+    if QW>qword(high(Int64)) then
+      QWordValue(QW)
+    else
+      if QW>MaxInt then
+      begin
+        I64 := QW;
+        Int64Value(I64);
+      end
+      else
+      begin
+        I:=QW;
+        IntegerValue(I);
+      end
+    end
+  else
+    begin
+    If TryStrToInt64(S,I64) then
+      if (I64>Maxint) or (I64<-MaxInt) then
+        Int64Value(I64)
+      Else
+        begin
+        I:=I64;
+        IntegerValue(I);
+        end
+    else
+      begin
+      I:=0;
+      Val(S,F,I);
+      If (I<>0) then
+        DoError(SErrInvalidNumber);
+      FloatValue(F);
+      end;
+    end;
+end;
+
+function TBaseJSONReader.GetO(AIndex: TJSONOption): Boolean;
+begin
+  Result:=AIndex in Options;
+end;
+
+function TBaseJSONReader.GetOptions: TJSONOptions;
+begin
+  Result:=FScanner.Options
+end;
+
+procedure TBaseJSONReader.SetO(AIndex: TJSONOption; AValue: Boolean);
+begin
+  if aValue then
+    FScanner.Options:=FScanner.Options+[AINdex]
+  else
+    FScanner.Options:=FScanner.Options-[AINdex]
+end;
+
+procedure TBaseJSONReader.SetOptions(AValue: TJSONOptions);
+begin
+  FScanner.Options:=AValue;
+end;
+
+
+// Current token is {, on exit current token is }
+Procedure TBaseJSONReader.ParseObject;
+
+Var
+  T : TJSONtoken;
+  LastComma : Boolean;
+
+begin
+  LastComma:=False;
+  StartObject;
+  T:=GetNextToken;
+  While T<>tkCurlyBraceClose do
+    begin
+    If (T<>tkString) and (T<>tkIdentifier) then
+      DoError(SErrExpectedElementName);
+    KeyValue(CurrentTokenString);
+    T:=GetNextToken;
+    If (T<>tkColon) then
+      DoError(SErrExpectedColon);
+    DoParse(False,False);
+    T:=GetNextToken;
+    If Not (T in [tkComma,tkCurlyBraceClose]) then
+      DoError(SExpectedCommaorBraceClose);
+    If T=tkComma then
+      begin
+      T:=GetNextToken;
+      LastComma:=(t=tkCurlyBraceClose);
+      end;
+    end;
+  If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options))  then // Test for ,} case
+    DoError(SErrUnExpectedToken);
+  EndObject;
+end;
+
+// Current token is [, on exit current token is ]
+Procedure TBaseJSONReader.ParseArray;
+
+Var
+  T : TJSONtoken;
+  LastComma : Boolean;
+  S : TJSONOPTions;
+
+begin
+  StartArray;
+  LastComma:=False;
+  Repeat
+    T:=GetNextToken;
+    If (T<>tkSquaredBraceClose) then
+      begin
+      DoParse(True,False);
+      T:=GetNextToken;
+      If Not (T in [tkComma,tkSquaredBraceClose]) then
+        DoError(SExpectedCommaorBraceClose);
+      LastComma:=(t=TkComma);
+      end;
+  Until (T=tkSquaredBraceClose);
+  S:=Options;
+  If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S))  then // Test for ,] case
+    DoError(SErrUnExpectedToken);
+  EndArray;
+end;
+
+// Get next token, discarding whitespace
+function TBaseJSONReader.GetNextToken: TJSONToken;
+
+begin
+  Repeat
+    Result:=FScanner.FetchToken;
+  Until (Not (Result in [tkComment,tkWhiteSpace]));
+end;
+
+procedure TBaseJSONReader.DoError(const Msg: String);
+
+Var
+  S : String;
+
+begin
+  S:=Format(Msg,[CurrentTokenString]);
+  S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
+  Raise EJSONParser.Create(S);
+end;
+
+constructor TBaseJSONReader.Create(Source: TStream; AUseUTF8 : Boolean = True);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
+  if AUseUTF8 then
+   Options:=Options + [joUTF8];
+end;
+
+constructor TBaseJSONReader.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
+begin
+  Inherited Create;
+  FScanner:=TJSONScanner.Create(Source,[joUTF8]);
+  if AUseUTF8 then
+   Options:=Options + [joUTF8];
+end;
+
+constructor TBaseJSONReader.Create(Source: TStream; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
+constructor TBaseJSONReader.Create(const Source: String; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
+destructor TBaseJSONReader.Destroy();
+begin
+  FreeAndNil(FScanner);
+  inherited Destroy();
+end;
+
+{ TJSONReader }
+
+procedure TJSONEventReader.KeyValue(const AKey: TJSONStringType);
+begin
+  if Assigned(FOnKeyName) then
+    FOnKeyName(Self,AKey);
+end;
+
+procedure TJSONEventReader.StringValue(const AValue: TJSONStringType);
+begin
+  if Assigned(FOnStringValue) then
+    FOnStringValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.NullValue;
+begin
+  if Assigned(FOnNullValue) then
+    FOnNullValue(Self);
+end;
+
+procedure TJSONEventReader.FloatValue(const AValue: Double);
+begin
+  if Assigned(FOnFloatValue) then
+    FOnFloatValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.BooleanValue(const AValue: Boolean);
+begin
+  if Assigned(FOnBooleanValue) then
+    FOnBooleanValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.NumberValue(const AValue: TJSONStringType);
+begin
+  if Assigned(FOnNumberValue) then
+    FOnNumberValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.IntegerValue(const AValue: integer);
+begin
+  if Assigned(FOnIntegerValue) then
+    FOnIntegerValue(Self,AValue);
+
+end;
+
+procedure TJSONEventReader.Int64Value(const AValue: int64);
+begin
+  if Assigned(FOnInt64Value) then
+    FOnInt64Value(Self,AValue);
+
+end;
+
+procedure TJSONEventReader.QWordValue(const AValue: QWord);
+begin
+  if Assigned(FOnQWordValue) then
+    FOnQWordValue(Self,AValue);
+end;
+
+procedure TJSONEventReader.StartArray;
+begin
+  If Assigned(FOnStartArray) then
+    FOnStartArray(Self);
+end;
+
+procedure TJSONEventReader.StartObject;
+begin
+  if Assigned(FOnStartObject) then
+    FOnStartObject(Self);
+end;
+
+procedure TJSONEventReader.EndArray;
+begin
+  If Assigned(FOnEndArray) then
+    FOnEndArray(Self);
+end;
+
+procedure TJSONEventReader.EndObject;
+begin
+  If Assigned(FOnEndObject) then
+   FOnEndObject(Self);
+end;
+
+procedure TJSONEventReader.Execute;
+begin
+  DoExecute;
+end;
+
+{ TJSONConsumerReader }
+
+procedure TJSONConsumerReader.KeyValue(const AKey: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.KeyName(Akey)
+end;
+
+procedure TJSONConsumerReader.StringValue(const AValue: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.StringValue(AValue);
+end;
+
+procedure TJSONConsumerReader.NullValue;
+begin
+  If Assigned(FConsumer) then
+    FConsumer.NullValue;
+end;
+
+procedure TJSONConsumerReader.FloatValue(const AValue: Double);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.FloatValue(AValue);
+end;
+
+procedure TJSONConsumerReader.BooleanValue(const AValue: Boolean);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.BooleanValue(AValue);
+end;
+
+procedure TJSONConsumerReader.NumberValue(const AValue: TJSONStringType);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.NumberValue(AValue);
+end;
+
+procedure TJSONConsumerReader.IntegerValue(const AValue: integer);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.IntegerValue(AValue);
+end;
+
+procedure TJSONConsumerReader.Int64Value(const AValue: int64);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.Int64Value(AValue);
+end;
+
+procedure TJSONConsumerReader.QWordValue(const AValue: QWord);
+begin
+  If Assigned(FConsumer) then
+    FConsumer.QWordValue(AValue);
+end;
+
+procedure TJSONConsumerReader.StartArray;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.StartArray;
+end;
+
+procedure TJSONConsumerReader.StartObject;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.StartObject;
+end;
+
+procedure TJSONConsumerReader.EndArray;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.EndArray;
+end;
+
+procedure TJSONConsumerReader.EndObject;
+begin
+  if Assigned(FConsumer) then
+    FConsumer.EndObject;
+end;
+
+procedure TJSONConsumerReader.Execute;
+begin
+  DoExecute;
+end;
+
+
+end.
+

+ 538 - 0
compiler/packages/fcl-json/src/jsonscanner.pp

@@ -0,0 +1,538 @@
+{
+    This file is part of the Free Component Library
+
+    JSON source lexical scanner
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+
+{$ifdef fpc}
+  {$define UsePChar}
+{$endif}
+
+unit jsonscanner;
+
+interface
+
+uses SysUtils, Classes;
+
+resourcestring
+  SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
+  SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
+  SErrOpenString = 'string exceeds end of line';
+
+type
+
+  TJSONToken = (
+    tkEOF,
+    tkWhitespace,
+    tkString,
+    tkNumber,
+    tkTrue,
+    tkFalse,
+    tkNull,
+    // Simple (one-character) tokens
+    tkComma,                 // ','
+    tkColon,                 // ':'
+    tkCurlyBraceOpen,        // '{'
+    tkCurlyBraceClose,       // '}'
+    tkSquaredBraceOpen,       // '['
+    tkSquaredBraceClose,      // ']'
+    tkIdentifier,            // Any Javascript identifier
+    tkComment,
+    tkUnknown
+    );
+
+  EScannerError = class(EParserError);
+
+  TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
+  TJSONOptions = set of TJSONOption;
+
+Const
+  DefaultOptions = [joUTF8];
+
+Type
+
+  { TJSONScanner }
+
+  TJSONScanner = class
+  private
+    FSource: TStringList;
+    FCurRow: Integer;
+    FCurToken: TJSONToken;
+    FCurTokenString: string;
+    FCurLine: string;
+    FTokenStr: {$ifdef UsePChar}PChar{$else}integer{$endif}; // position inside FCurLine
+    FOptions : TJSONOptions;
+    function GetCurColumn: Integer; inline;
+    function GetO(AIndex: TJSONOption): Boolean;
+    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
+  protected
+    procedure Error(const Msg: string);overload;
+    procedure Error(const Msg: string;
+      Const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});overload;
+    function DoFetchToken: TJSONToken; inline;
+  public
+    {$ifdef fpc}
+    constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
+    constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';
+    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    {$endif}
+    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
+    destructor Destroy; override;
+    function FetchToken: TJSONToken;
+
+
+    property CurLine: string read FCurLine;
+    property CurRow: Integer read FCurRow;
+    property CurColumn: Integer read GetCurColumn;
+
+    property CurToken: TJSONToken read FCurToken;
+    property CurTokenString: string read FCurTokenString;
+    // Use strict JSON: " for strings, object members are strings, not identifiers
+    Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
+    // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
+    Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
+    // Parsing options
+    Property Options : TJSONOptions Read FOptions Write FOptions;
+  end;
+
+const
+  TokenInfos: array[TJSONToken] of string = (
+    'EOF',
+    'Whitespace',
+    'String',
+    'Number',
+    'True',
+    'False',
+    'Null',
+    ',',
+    ':',
+    '{',
+    '}',
+    '[',
+    ']',
+    'identifier',
+    'comment',
+    ''
+  );
+
+
+implementation
+
+{$ifdef fpc}
+constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
+
+Var
+  O : TJSONOptions;
+
+begin
+  O:=DefaultOptions;
+  if AUseUTF8 then
+    Include(O,joUTF8)
+  else
+    Exclude(O,joUTF8);
+  Create(Source,O);
+end;
+
+constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
+Var
+  O : TJSONOptions;
+
+begin
+  O:=DefaultOptions;
+  if AUseUTF8 then
+    Include(O,joUTF8)
+  else
+    Exclude(O,joUTF8);
+  Create(Source,O);
+end;
+
+constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
+begin
+  FSource:=TStringList.Create;
+  FSource.LoadFromStream(Source);
+  FOptions:=AOptions;
+end;
+{$endif}
+
+constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
+begin
+  FSource:=TStringList.Create;
+  FSource.Text:=Source;
+  FOptions:=AOptions;
+end;
+
+destructor TJSONScanner.Destroy;
+begin
+  FreeAndNil(FSource);
+  Inherited;
+end;
+
+
+function TJSONScanner.FetchToken: TJSONToken;
+  
+begin
+  Result:=DoFetchToken;
+end;
+
+procedure TJSONScanner.Error(const Msg: string);
+begin
+  raise EScannerError.Create(Msg);
+end;
+
+procedure TJSONScanner.Error(const Msg: string;
+  const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
+begin
+  raise EScannerError.CreateFmt(Msg, Args);
+end;
+
+function TJSONScanner.DoFetchToken: TJSONToken;
+
+  function FetchLine: Boolean;
+  begin
+    Result:=FCurRow<FSource.Count;
+    if Result then
+      begin
+      FCurLine:=FSource[FCurRow];
+      FTokenStr:=PChar(FCurLine);
+      Inc(FCurRow);
+      end
+    else             
+      begin
+      FCurLine:='';
+      FTokenStr:=nil;
+      end;
+  end;
+
+var
+  TokenStart: PChar;
+  it : TJSONToken;
+  I : Integer;
+  OldLength, SectionLength,  tstart,tcol, u1,u2: Integer;
+  C , c2: char;
+  S : String;
+  IsStar,EOC: Boolean;
+
+  Procedure MaybeAppendUnicode;
+
+  Var
+    u : String;
+
+  begin
+  // if there is a leftover \u, append
+  if (u1<>0) then
+    begin
+    if (joUTF8 in Options) or (DefaultSystemCodePage=CP_UTF8) then
+      U:=Utf8Encode(WideString(WideChar(u1))) // ToDo: use faster function
+    else
+      U:=String(WideChar(u1)); // WideChar converts the encoding. Should it warn on loss?
+    FCurTokenString:=FCurTokenString+U;
+    OldLength:=Length(FCurTokenString);
+    u1:=0;
+    end;
+  end;
+
+
+begin
+  if FTokenStr = nil then
+    if not FetchLine then
+      begin
+      Result := tkEOF;
+      FCurToken := Result;
+      exit;
+      end;
+
+  FCurTokenString := '';
+
+  case FTokenStr[0] of
+    #0:         // Empty line
+      begin
+      FetchLine;
+      Result := tkWhitespace;
+      end;
+    #9, ' ':
+      begin
+      Result := tkWhitespace;
+      repeat
+        Inc(FTokenStr);
+        if FTokenStr[0] = #0 then
+          if not FetchLine then
+          begin
+            FCurToken := Result;
+            exit;
+          end;
+      until not (FTokenStr[0] in [#9, ' ']);
+      end;
+    '"','''':
+      begin
+        C:=FTokenStr[0];
+        If (C='''') and (joStrict in Options) then
+          Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+        Inc(FTokenStr);
+        TokenStart := FTokenStr;
+        OldLength := 0;
+        FCurTokenString := '';
+        u1:=0;
+        while not (FTokenStr[0] in [#0,C]) do
+          begin
+          if (FTokenStr[0]='\') then
+            begin
+            // Save length
+            SectionLength := FTokenStr - TokenStart;
+            Inc(FTokenStr);
+            // Read escaped token
+            Case FTokenStr[0] of
+              '"' : S:='"';
+              '''' : S:='''';
+              't' : S:=#9;
+              'b' : S:=#8;
+              'n' : S:=#10;
+              'r' : S:=#13;
+              'f' : S:=#12;
+              '\' : S:='\';
+              '/' : S:='/';
+              'u' : begin
+                    S:='0000';
+                    u2:=0;
+                    For I:=1 to 4 do
+                      begin
+                      Inc(FTokenStr);
+                      c2:=FTokenStr^;
+                      Case c2 of
+                        '0'..'9': u2:=u2*16+ord(c2)-ord('0');
+                        'A'..'F': u2:=u2*16+ord(c2)-ord('A')+10;
+                        'a'..'f': u2:=u2*16+ord(c2)-ord('a')+10;
+                      else
+                        Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+                      end;
+                      end;
+                    // ToDo: 4-bytes UTF16
+                    if u1<>0 then
+                      begin
+                      if (joUTF8 in Options) or (DefaultSystemCodePage=CP_UTF8) then
+                        S:=Utf8Encode(WideString(WideChar(u1)+WideChar(u2))) // ToDo: use faster function
+                      else
+                        S:=String(WideChar(u1)+WideChar(u2)); // WideChar converts the encoding. Should it warn on loss?
+                      u1:=0;
+                      end
+                    else
+                      begin
+                      S:='';
+                      u1:=u2;
+                      end
+                    end;
+              #0  : Error(SErrOpenString);
+            else
+              Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+            end;
+            I:=Length(S);
+            if (SectionLength+I>0) then
+              begin
+              // If length=1, we know it was not \uXX, but u1 can be nonzero, and we must first append it.
+              // example: \u00f8\"
+              if I=1 then
+                MaybeAppendUnicode;
+              SetLength(FCurTokenString, OldLength + SectionLength+Length(S));
+              if SectionLength > 0 then
+                Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+              if I>0 then
+                Move(S[1],FCurTokenString[OldLength + SectionLength+1],i);
+              Inc(OldLength, SectionLength+Length(S));
+              end;
+            // Next char
+            TokenStart := FTokenStr+1;
+            end
+          else
+            MaybeAppendUnicode;
+          if FTokenStr[0] = #0 then
+            Error(SErrOpenString);
+          Inc(FTokenStr);
+          end;
+        if FTokenStr[0] = #0 then
+          Error(SErrOpenString);
+        MaybeAppendUnicode;
+        SectionLength := FTokenStr - TokenStart;
+        SetLength(FCurTokenString, OldLength + SectionLength);
+        if SectionLength > 0 then
+          Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
+        Inc(FTokenStr);
+        Result := tkString;
+      end;
+    ',':
+      begin
+        Inc(FTokenStr);
+        Result := tkComma;
+      end;
+    '0'..'9','.','-':
+      begin
+        TokenStart := FTokenStr;
+        while true do
+        begin
+          Inc(FTokenStr);
+          case FTokenStr[0] of
+            '.':
+              begin
+                if FTokenStr[1] in ['0'..'9', 'e', 'E'] then
+                begin
+                  Inc(FTokenStr);
+                  repeat
+                    Inc(FTokenStr);
+                  until not (FTokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
+                end;
+                break;
+              end;
+            '0'..'9': ;
+            'e', 'E':
+              begin
+                Inc(FTokenStr);
+                if FTokenStr[0] in ['-','+']  then
+                  Inc(FTokenStr);
+                while FTokenStr[0] in ['0'..'9'] do
+                  Inc(FTokenStr);
+                break;
+              end;
+          else
+            if not (FTokenStr[0] in [#0,'}',']',',',#9,' ']) then
+               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+            break;
+          end;
+        end;
+        SectionLength := FTokenStr - TokenStart;
+        FCurTokenString:='';
+        SetString(FCurTokenString, TokenStart, SectionLength);
+        If (FCurTokenString[1]='.') then
+          FCurTokenString:='0'+FCurTokenString;
+        Result := tkNumber;
+      end;
+    ':':
+      begin
+        Inc(FTokenStr);
+        Result := tkColon;
+      end;
+    '{':
+      begin
+        Inc(FTokenStr);
+        Result := tkCurlyBraceOpen;
+      end;
+    '}':
+      begin
+        Inc(FTokenStr);
+        Result := tkCurlyBraceClose;
+      end;  
+    '[':
+      begin
+        Inc(FTokenStr);
+        Result := tkSquaredBraceOpen;
+      end;
+    ']':
+      begin
+        Inc(FTokenStr);
+        Result := tkSquaredBraceClose;
+      end;
+    '/' :
+      begin
+      if Not (joComments in Options) then
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,FTokenStr[0]]);
+      TokenStart:=FTokenStr;
+      Inc(FTokenStr);
+      Case FTokenStr[0] of
+        '/' : begin
+              SectionLength := Length(FCurLine)- (FTokenStr - PChar(FCurLine));
+              Inc(FTokenStr);
+              FCurTokenString:='';
+              SetString(FCurTokenString, FTokenStr, SectionLength);
+              Fetchline;
+              end;
+        '*' :
+          begin
+          IsStar:=False;
+          Inc(FTokenStr);
+          TokenStart:=FTokenStr;
+          Repeat
+            if (FTokenStr[0]=#0) then
+              begin
+              SectionLength := (FTokenStr - TokenStart);
+              S:='';
+              SetString(S, TokenStart, SectionLength);
+              FCurtokenString:=FCurtokenString+S;
+              if not fetchLine then
+                Error(SUnterminatedComment, [CurRow,CurCOlumn,FTokenStr[0]]);
+              TokenStart:=FTokenStr;
+              end;
+            IsStar:=FTokenStr[0]='*';
+            Inc(FTokenStr);
+            EOC:=(isStar and (FTokenStr[0]='/'));
+          Until EOC;
+          if EOC then
+            begin
+            SectionLength := (FTokenStr - TokenStart-1);
+            S:='';
+            SetString(S, TokenStart, SectionLength);
+            FCurtokenString:=FCurtokenString+S;
+            Inc(FTokenStr);
+            end;
+          end;
+      else
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,FTokenStr[0]]);
+      end;
+      Result:=tkComment;
+      end;
+    'a'..'z','A'..'Z','_':
+      begin
+        tstart:=CurRow;
+        Tcol:=CurColumn;
+        TokenStart := FTokenStr;
+        repeat
+          Inc(FTokenStr);
+        until not (FTokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+        SectionLength := FTokenStr - TokenStart;
+        FCurTokenString:='';
+        SetString(FCurTokenString, TokenStart, SectionLength);
+        for it := tkTrue to tkNull do
+          if CompareText(CurTokenString, TokenInfos[it]) = 0 then
+            begin
+            Result := it;
+            FCurToken := Result;
+            exit;
+            end;
+        if (joStrict in Options) then
+          Error(SErrInvalidCharacter, [tStart,tcol,TokenStart[0]])
+        else
+          Result:=tkIdentifier;
+      end;
+  else
+    Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+  end;
+
+  FCurToken := Result;
+end;
+
+function TJSONScanner.GetCurColumn: Integer;
+begin
+  Result := FTokenStr - PChar(CurLine);
+end;
+
+function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;
+begin
+  Result:=AIndex in FOptions;
+end;
+
+procedure TJSONScanner.SetO(AIndex: TJSONOption; AValue: Boolean);
+begin
+  If AValue then
+    Include(Foptions,AIndex)
+  else
+    Exclude(Foptions,AIndex)
+end;
+
+end.

+ 360 - 0
compiler/packages/fcl-json/tests/jsonconftest.pp

@@ -0,0 +1,360 @@
+unit jsonconftest;
+
+{$mode objfpc}{$H+}
+{$codepage utf8}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, jsonconf;
+
+type
+
+  { TTestJSONConfig }
+
+  TTestJSONConfig= class(TTestCase)
+  Private
+    procedure AssertStrings(Msg: String; L: TStrings;
+      const Values: array of string);
+    Function CreateConf(AFileName : String) : TJSONCOnfig;
+    Procedure DeleteConf(C : TJSONConfig; DeleteConfFile : Boolean = true);
+  published
+    procedure TestDataTypes;
+    procedure TestSubNodes;
+    procedure TestEnumSubkeys;
+    procedure TestEnumValues;
+    procedure TestClear;
+    procedure TestKey;
+    procedure TestStrings;
+    procedure TestUnicodeStrings;
+  end;
+
+implementation
+
+function TTestJSONConfig.CreateConf(AFileName: String): TJSONCOnfig;
+begin
+  Result:=TJSONConfig.Create(Nil);
+  Result.FileName:=AFileName;
+end;
+
+procedure TTestJSONConfig.DeleteConf(C: TJSONConfig; DeleteConfFile: Boolean);
+
+Var
+  FN : String;
+
+begin
+  If DeleteConfFile then
+    FN:=C.FileName;
+  FreeAndNil(C);
+  If DeleteConfFile then
+    DeleteFile(FN);
+end;
+
+procedure TTestJSONConfig.TestDataTypes;
+
+Const
+  A = Integer(1);
+  B = 'A string';
+  C = 1.23;
+  D = True;
+  E = Int64($FFFFFFFFFFFFF);
+
+Var
+  Co : TJSONCOnfig;
+
+begin
+  Co:=CreateConf('test.json');
+  try
+    Co.SetValue('a',a);
+    AssertEquals('Integer read/Write',a,Co.GetValue('a',0));
+    Co.SetValue('b',b);
+    AssertEquals('String read/Write',b,Co.GetValue('b',''));
+    Co.SetValue('c',C);
+    AssertEquals('Float read/Write',c,Co.GetValue('c',0.0),0.01);
+    Co.SetValue('d',d);
+    AssertEquals('Boolean read/Write',d,Co.GetValue('d',False));
+    Co.SetValue('e',E);
+    AssertEquals('Int64 read/Write',e,Co.GetValue('e',Int64(0)));
+    Co.Flush;
+  finally
+    DeleteConf(Co,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestSubNodes;
+
+Var
+  C : TJSONCOnfig;
+
+begin
+  C:=CreateConf('test.json');
+  try
+    C.SetValue('a',1);
+    AssertEquals('Read at root',1,C.GetValue('a',0));
+    C.SetValue('b/a',2);
+    AssertEquals('Read at root',2,C.GetValue('b/a',2));
+    C.SetValue('b/c/a',3);
+    AssertEquals('Read at root',3,C.GetValue('b/c/a',3));
+  finally
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestEnumSubkeys;
+Var
+  C : TJSONCOnfig;
+  L : TStringList;
+  
+begin
+  C:=CreateConf('test.json');
+  try
+    C.SetValue('/a',1);
+    C.SetValue('/b/a',2);
+    C.SetValue('/b/b',2);
+    C.SetValue('/c/a',3);
+    C.SetValue('/c/b/a',4);
+    C.SetValue('/c/c/a',4);
+    C.SetValue('/c/d/d',4);
+    L:=TStringList.Create;
+    try
+      C.EnumSubKeys('/',L);
+      If (L.Count<>2) then
+        Fail('EnumSubkeys count');
+      If (L[0]<>'b') then
+        Fail('EnumSubkeys first element');
+      If (L[1]<>'c') then
+        Fail('EnumSubkeys second element');
+    finally
+      L.Free;
+    end;
+  finally
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestEnumValues;
+Var
+  C : TJSONCOnfig;
+  L : TStringList;
+
+begin
+  C:=CreateConf('test.json');
+  try
+    C.SetValue('/a',1);
+    C.SetValue('/b/a',2);
+    C.SetValue('/b/b',2);
+    C.SetValue('/c/a',3);
+    C.SetValue('/c/b/a',4);
+    C.SetValue('/c/c/a',4);
+    C.SetValue('/c/d/d',4);
+    L:=TStringList.Create;
+    try
+      C.EnumValues('/',L);
+      If (L.Count<>1) then
+        Fail('EnumValues count');
+      If (L[0]<>'a') then
+        Fail('EnumValues first element');
+      L.Clear;
+      C.EnumValues('/b',L);
+      If (L.Count<>2) then
+        Fail('EnumValues subkey count');
+      If (L[0]<>'a') then
+        Fail('EnumValues subkey first element');
+      If (L[1]<>'b') then
+        Fail('EnumValues subkey second element');
+    finally
+      L.Free;
+    end;
+  finally
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestClear;
+
+Var
+  C : TJSONCOnfig;
+
+begin
+  C:=CreateConf('test.json');
+  try
+    C.SetValue('a',1);
+    C.Flush;
+    C.DeleteValue('a');
+    AssertEquals('Modified set',True,C.Modified);
+    AssertEquals('Delete value',0,C.GetValue('a',0));
+    C.SetValue('b/a',1);
+    C.SetValue('b/c',2);
+    C.DeleteValue('b/a');
+    AssertEquals('Delete value in subkey',0,C.GetValue('a',0));
+    AssertEquals('Delete value only clears deleted value',2,C.GetValue('b/c',0));
+    C.SetValue('b/a',1);
+    C.Flush;
+    C.DeletePath('b');
+    AssertEquals('Modified set',True,C.Modified);
+    AssertEquals('Delete path',0,C.GetValue('b/a',0));
+    AssertEquals('Delete path deletes all values',0,C.GetValue('b/c',0));
+    C.Clear;
+    AssertEquals('Clear',0,C.GetValue('/a',0));
+  finally
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestKey;
+
+Var
+  C : TJSONCOnfig;
+  L : TStrings;
+  
+begin
+  C:=CreateConf('test.json');
+  try
+    C.SetValue('a',1);
+    C.SetValue('b/a',2);
+    C.SetValue('b/b',2);
+    C.SetValue('b/c/a',3);
+    C.SetValue('b/c/b',3);
+    C.OpenKey('/b',False);
+    AssertEquals('Read relative to key a',2,C.GetValue('a',0));
+    AssertEquals('Read relative to key b',2,C.GetValue('b',0));
+    AssertEquals('Read in subkey relative to key a',3,C.GetValue('c/a',0));
+    AssertEquals('Read in subkey relative to key b',3,C.GetValue('c/b',0));
+    AssertEquals('Read absolute, disregarding key',1,C.GetValue('/a',0));
+    AssertEquals('Read absolute in subkey, disregarding key',2,C.GetValue('/b/a',0));
+    AssertEquals('Read absolute in subkeys, disregarding key',3,C.GetValue('/b/c/a',0));
+    C.CloseKey;
+    AssertEquals('Closekey',1,C.GetValue('a',0));
+    C.OpenKey('b',False);
+    C.OpenKey('c',False);
+    AssertEquals('Open relative key',3,C.GetValue('a',0));
+    C.ResetKey;
+    AssertEquals('ResetKey',1,C.GetValue('a',0));
+    C.Clear;
+    L:=TStringList.Create;
+    try
+      C.EnumSubKeys('/',L);
+      If (L.Count<>0) then
+        Fail('clear failed');
+      C.OpenKey('/a/b/c/d',true);
+      C.EnumSubKeys('/a',L);
+      If (L.Count<>1) then
+        Fail('Open key with allowcreate, level 1');
+      If (L[0]<>'b') then
+        Fail('Open key with allowcreate, level 1');
+      L.Clear;
+      C.EnumSubKeys('/a/b',L);
+      If (L.Count<>1) then
+        Fail('Open key with allowcreate, level 2');
+      If (L[0]<>'c') then
+        Fail('Open key with allowcreate, level 2');
+      L.Clear;
+      C.EnumSubKeys('/a/b/c',L);
+      If (L.Count<>1) then
+        Fail('Open key with allowcreate, level 3');
+      If (L[0]<>'d') then
+        Fail('Open key with allowcreate, level 3');
+    finally
+      L.Free;
+    end;
+  finally
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.AssertStrings(Msg: String; L: TStrings;
+  const Values: array of string);
+
+Var
+  I : Integer;
+begin
+  Msg:=Msg+': ';
+  AssertNotNull(Msg+'Have strings',L);
+  AssertEquals(Msg+'Correct element count',Length(Values),L.Count);
+  For I:=0 to L.Count-1 do
+    AssertEquals(Msg+'element '+IntToStr(i),Values[i],l[i]);
+end;
+
+procedure TTestJSONConfig.TestStrings;
+
+Var
+  C : TJSONCOnfig;
+  L,LD : TStrings;
+
+begin
+  L:=Nil;
+  LD:=Nil;
+  C:=CreateConf('test.json');
+  try
+    L:=TStringList.Create;
+    LD:=TStringList.Create;
+    L.Add('abc');
+    C.GetValue('list',L,'');
+    AssertStrings('Clear, no default.',L,[]);
+    C.GetValue('list',L,'text');
+    AssertStrings('Use default.',L,['text']);
+    L.Clear;
+    L.Add('abc');
+    L.Add('def');
+    C.SetValue('a',L);
+    C.GetValue('a',LD,'');
+    AssertStrings('List',LD,['abc','def']);
+    L.Clear;
+    L.Add('abc=1');
+    L.Add('def=2');
+    C.SetValue('a',L,True);
+    LD.Clear;
+    C.GetValue('a',LD,'');
+    AssertStrings('List',LD,['abc=1','def=2']);
+    C.SetValue('a','abc');
+    C.GetValue('a',L,'');
+    AssertStrings('String',L,['abc']);
+    C.SetValue('a',Integer(1));
+    C.GetValue('a',L,'');
+    AssertStrings('integer',L,['1']);
+    C.SetValue('a',True);
+    C.GetValue('a',L,'');
+    AssertStrings('integer',L,['True']);
+    C.SetValue('a',Int64(1));
+    C.GetValue('a',L,'');
+    AssertStrings('int64',L,['1']);
+  finally
+    L.Free;
+    DeleteConf(C,True);
+  end;
+end;
+
+procedure TTestJSONConfig.TestUnicodeStrings;
+
+Const
+  utf8str = 'Größe ÄÜÖ ㎰ す 가';
+  utf8path = 'Größe/す가';
+
+Var
+  Co : TJSONCOnfig;
+
+
+begin
+  Co:=CreateConf('test.json');
+  try
+    Co.SetValue('a',utf8str);
+    Co.SetValue(utf8path,'something');
+    Co.Flush;
+  finally
+    co.Free;
+  end;
+  Co:=CreateConf('test.json');
+  try
+    AssertEquals('UTF8 string read/Write',utf8str,utf8encode(Co.GetValue('a','')));
+    AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
+  finally
+    DeleteConf(Co,True);
+  end;
+end;
+
+
+initialization
+
+  RegisterTest(TTestJSONConfig); 
+end.
+

+ 620 - 0
compiler/packages/fcl-json/tests/tcjsonini.pp

@@ -0,0 +1,620 @@
+unit tcjsonini;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, inifiles, jsonini;
+
+Type
+
+  { TJSONIniTest }
+
+  TJSONIniTest = Class(TTestCase)
+  private
+    FFileContent: TJSONData;
+    Fini: TJSONIniFile;
+    FStrings: TStrings;
+    FTestFile: String;
+    procedure AssertValue(const aSection, Akey, avalue: string);
+    procedure CreateIni;
+    function GetIni: TJSONIniFile;
+    function GetO: TJSONObject;
+  Protected
+    procedure HaveFile;
+    Procedure ReLoad;
+    procedure NoFileYet;
+    procedure RemoveFile;
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Procedure ReadFile;
+    Procedure WriteFile;
+    Procedure SampleFile;
+    Property TestFile : String Read FTestFile;
+    Property FileContent : TJSONData Read FFileContent Write FFileContent;
+    Property ObjFileContent : TJSONObject Read GetO;
+    Property Ini : TJSONIniFile Read GetIni;
+    Property Strings : TStrings Read FStrings;
+  Published
+    Procedure TestEmpty;
+    Procedure TestReadEmpty;
+    Procedure TestReadEmptyValue;
+    Procedure TestReadEmptyObject;
+    Procedure TestRead1EmptySection;
+    Procedure TestReadSections;
+    procedure TestReadSection;
+    procedure TestReadSectionValues;
+    Procedure TestReadString;
+    Procedure TestReadInteger;
+    Procedure TestReadInt64;
+    Procedure TestReadFloat;
+    Procedure TestReadBoolean;
+    Procedure TestReadDate;
+    Procedure TestReadTime;
+    Procedure TestReadDateTime;
+    Procedure TestEraseSection;
+    Procedure TestEraseSectionCaseMismatch;
+    Procedure TestDeleteKey;
+    Procedure TestDeleteKeySectionCaseMismatch;
+    Procedure TestDeleteKeyKeyCaseMismatch;
+    Procedure TestWriteString;
+    Procedure TestWriteInteger;
+    Procedure TestWriteBoolean;
+    Procedure TestWriteDate;
+    Procedure TestWriteDateTime;
+    Procedure TestWriteTime;
+    Procedure TestConvertIni;
+    Procedure TestConvertIniString;
+  end;
+
+implementation
+
+{ TJSONIniTest }
+
+function TJSONIniTest.GetIni: TJSONIniFile;
+begin
+  If FIni=Nil then
+    begin
+    Fini:=TJSONIniFile.Create(TestFile);
+    end;
+  Result:=FIni;
+end;
+
+function TJSONIniTest.GetO: TJSONObject;
+begin
+  Result:=FFileContent as TJSONObject;
+end;
+
+procedure TJSONIniTest.Setup;
+begin
+  Inherited;
+  FTestFile:=TestName+'.json';
+  If FileExists(FTestFile) then
+    DeleteFile(FTestFile);
+  FStrings:=TStringList.Create;
+  // Do nothing
+end;
+
+procedure TJSONIniTest.TearDown;
+begin
+  If FileExists(FTestFile) then
+    DeleteFile(FTestFile);
+  FreeAndNil(FFileContent);
+  FreeAndNil(FIni);
+  FreeAndNil(FStrings);
+  Inherited;
+end;
+
+procedure TJSONIniTest.ReadFile;
+
+Var
+  F : TFileStream;
+
+begin
+  FreeAndNil(FFileContent);
+  AssertTrue('Test File '+TestFile+' exists.',FileExists(TestFile));
+  F:=TFileStream.Create(TestFile,fmOpenRead or fmShareDenyWrite);
+  try
+    FileContent:=GetJSON(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TJSONIniTest.WriteFile;
+
+Var
+  F : TFileStream;
+  S : TJSONStringType;
+
+begin
+  F:=TFileStream.Create(TestFile,fmCreate);
+  try
+    S:=FFileContent.AsJSON;
+    F.WriteBuffer(S[1],Length(S));
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TJSONIniTest.SampleFile;
+
+begin
+  FileContent:=TJSONObject.Create([
+    'a',TJSONObject.Create([
+      'i',1,
+      'i6',TJSONInt64Number.Create(Maxint*2),
+      'f',1.2,
+      's','test',
+      'si','1',
+      'si6',IntToStr(int64(MaxInt*2)),
+      'sf','1.2',
+      'dt','2001-05-06T23:24:25.678',
+      'id',Round(EncodeDate(2001,05,06)),
+      'fd',EncodeDate(2001,05,06),
+      't','0000-00-00T12:13:14.567',
+      'ft',Frac(EncodeTime(12,13,14,567)),
+      'fdt',EncodeDate(2001,05,06)+EncodeTime(23,24,25,678),
+      'd','2001-05-06',
+      'b',true,
+      'n',Nil,
+      'o',TJSONObject.Create
+    ]),
+    'B',TJSONObject.Create([
+      'I',1,
+      'F',1.2,
+      'S','test',
+      'SI','1',
+      'SF','1.2',
+      'DT','2001-05-06T23:24:25.678',
+      'T','0000-00-00T12:13:14.567',
+      'D','2001-05-06',
+      'B',true,
+      'N',Nil,
+      'O',TJSONObject.Create
+    ]),
+    'NO','not'
+  ]);
+  WriteFile;
+end;
+
+procedure TJSONIniTest.TestEmpty;
+begin
+  AssertFalse('No test file',FileExists(testfile));
+  AssertNull('No ini',Fini);
+  AssertNull('No file content',FFileContent);
+  AssertNotNull('Have strings',Strings);
+  AssertEquals('Have empty strings',0,Strings.Count);
+end;
+
+procedure TJSONIniTest.TestReadEmpty;
+begin
+  Ini.ReadSections(Strings);
+  AssertEquals('No sections',0,Strings.Count);
+end;
+
+procedure TJSONIniTest.TestReadEmptyValue;
+begin
+  FileContent:=TJSONString.Create('me');
+  WriteFile;
+  Ini.ReadSections(Strings);
+  AssertEquals('No sections',0,Strings.Count);
+end;
+
+procedure TJSONIniTest.TestReadEmptyObject;
+begin
+  FileContent:=TJSONObject.Create();
+  WriteFile;
+  Ini.ReadSections(Strings);
+  AssertEquals('No sections',0,Strings.Count);
+end;
+
+procedure TJSONIniTest.TestRead1EmptySection;
+begin
+  FileContent:=TJSONObject.Create(['empty',TJSONOBject.Create]);
+  WriteFile;
+  Ini.ReadSections(Strings);
+  AssertEquals('1 sections',1,Strings.Count);
+  AssertEquals('Section name','empty',Strings[0]);
+end;
+
+procedure TJSONIniTest.TestReadSections;
+begin
+  SampleFile;
+  Ini.ReadSections(Strings);
+  AssertEquals('2 sections',2,Strings.Count);
+  AssertEquals('Section name 0','a',Strings[0]);
+  AssertEquals('Section name 1','B',Strings[1]);
+end;
+
+procedure TJSONIniTest.TestReadSection;
+begin
+  SampleFile;
+  Ini.ReadSection('a',Strings);
+  // Only valid values are reported
+  AssertEquals('value count',(FileContent as TJSONObject).Objects['a'].Count-2,Strings.Count);
+  AssertEquals('value names','i,i6,f,s,si,si6,sf,dt,id,fd,t,ft,fdt,d,b',Strings.CommaText);
+end;
+
+procedure TJSONIniTest.TestReadSectionValues;
+
+Var
+  D : TJSONEnum;
+
+begin
+  SampleFile;
+  Ini.ReadSectionValues('a',Strings,[]);
+  // Only valid values are reported
+  AssertEquals('value count',(FileContent as TJSONObject).Objects['a'].Count-2,Strings.Count);
+  for D in (FileContent as TJSONObject).Objects['a'] do
+    if D.Value.JSONType in ActualValueJSONTypes then
+      AssertEquals('value '+D.key,D.Value.AsString,Strings.Values[D.Key]);
+  Strings.Clear;
+  Ini.ReadSectionValues('a',Strings);
+  // All valid values are reported
+  AssertEquals('value count',(FileContent as TJSONObject).Objects['a'].Count,Strings.Count);
+end;
+
+procedure TJSONIniTest.TestReadString;
+begin
+  SampleFile;
+  AssertEquals('Value, case OK','test',Ini.ReadString('a','s','nono'));
+  AssertEquals('Value, key case not OK','test',Ini.ReadString('a','S','nono'));
+  AssertEquals('Value, section case not OK','test',Ini.ReadString('A','s','nono'));
+  AssertEquals('Value, section not exist','nono',Ini.ReadString('C','s','nono'));
+  AssertEquals('Value, key not exist','nono',Ini.ReadString('a','Z','nono'));
+  AssertEquals('Value, key not string','1',Ini.ReadString('a','i','nono'));
+  AssertEquals('Value, key not valid value','nono',Ini.ReadString('a','o','nono'));
+end;
+
+procedure TJSONIniTest.TestReadInteger;
+
+begin
+  SampleFile;
+  AssertEquals('Value, case OK',1,Ini.ReadInteger('a','i',2));
+  AssertEquals('Value, key case not OK',1,Ini.ReadInteger('a','I',2));
+  AssertEquals('Value, section case not OK',1,Ini.ReadInteger('A','i',2));
+  AssertEquals('Value, section not exist',2,Ini.ReadInteger('C','i',2));
+  AssertEquals('Value, key not exist',2,Ini.ReadInteger('a','Z',2));
+  AssertEquals('Value, key not integer',2,Ini.ReadInteger('a','s',2));
+  AssertEquals('Value, key not integer, but convertable to integer',1,Ini.ReadInteger('a','si',2));
+end;
+
+procedure TJSONIniTest.TestReadInt64;
+Var
+  I6 : Int64;
+begin
+  I6:=MaxInt*2;
+  SampleFile;
+  AssertEquals('Value, case OK',i6,Ini.ReadInt64('a','i6',2));
+  AssertEquals('Value, key case not OK',i6,Ini.ReadInt64('a','I6',2));
+  AssertEquals('Value, section case not OK',i6,Ini.ReadInt64('A','i6',2));
+  AssertEquals('Value, section not exist',2,Ini.ReadInt64('C','i',2));
+  AssertEquals('Value, key not exist',2,Ini.ReadInt64('a','Z',2));
+  AssertEquals('Value, key not integer',2,Ini.ReadInt64('a','s',2));
+  AssertEquals('Value, key not integer, but convertable to int64',I6,Ini.ReadInt64('a','si6',2));
+end;
+
+procedure TJSONIniTest.TestReadFloat;
+begin
+  SampleFile;
+  AssertEquals('Value, case OK',1.2,Ini.ReadFloat('a','f',2.3));
+  AssertEquals('Value, key case not OK',1.2,Ini.ReadFloat('a','F',2.3));
+  AssertEquals('Value, section case not OK',1.2,Ini.ReadFloat('A','f',2.3));
+  AssertEquals('Value, section not exist',2.3,Ini.ReadFloat('C','f',2.3));
+  AssertEquals('Value, key not exist',2.3,Ini.ReadFloat('a','Z',2.3));
+  AssertEquals('Value, key not float',2.3,Ini.ReadFloat('a','s',2.3));
+  AssertEquals('Value, key not float, but convertable to float',1.2,Ini.ReadFloat('a','sf',2.3));
+end;
+
+procedure TJSONIniTest.TestReadBoolean;
+begin
+  SampleFile;
+  AssertEquals('Value, case OK',True,Ini.ReadBool('a','b',False));
+  AssertEquals('Value, key case not OK',True,Ini.ReadBool('a','B',False));
+  AssertEquals('Value, section case not OK',True,Ini.ReadBool('A','b',False));
+  AssertEquals('Value, section not exist',True,Ini.ReadBool('C','b',True));
+  AssertEquals('Value, key not exist',True,Ini.ReadBool('a','Z',True));
+  AssertEquals('Value, key not bool but integer',True,Ini.ReadBool('a','i',false));
+end;
+
+procedure TJSONIniTest.TestReadDate;
+
+Var
+  D,DD : TDateTime;
+
+begin
+  D:=EncodeDate(2001,05,06);
+  DD:=EncodeDate(1999,11,12);
+  SampleFile;
+  AssertEquals('Value, case OK',D,Ini.ReadDate('a','d',DD));
+  AssertEquals('Value, key case not OK',D,Ini.ReadDate('a','D',DD));
+  AssertEquals('Value, section case not OK',D,Ini.ReadDate('A','d',DD));
+  AssertEquals('Value, section not exist',DD,Ini.ReadDate('C','d',DD));
+  AssertEquals('Value, date as integer',D,Ini.ReadDate('a','id',DD));
+  AssertEquals('Value, date as float',D,Ini.ReadDate('a','fd',DD));
+end;
+
+procedure TJSONIniTest.TestReadTime;
+
+Var
+  T,DT : TDateTime;
+
+begin
+  T:=EncodeTime(12,13,14,567);
+  DT:=EncodeTime(1,2,3,4);
+  SampleFile;
+  AssertEquals('Value, case OK',T,Ini.ReadTime('a','t',DT));
+  AssertEquals('Value, key case not OK',T,Ini.ReadTime('a','T',DT));
+  AssertEquals('Value, section case not OK',T,Ini.ReadTime('A','t',DT));
+  AssertEquals('Value, section not exist',DT,Ini.ReadTime('C','t',DT));
+  AssertEquals('Value, key exist as float',T,Ini.ReadTime('a','ft',DT));
+end;
+
+procedure TJSONIniTest.TestReadDateTime;
+Var
+  DT,DDT : TDateTime;
+
+begin
+  DT:=EncodeDate(2001,05,06)+EncodeTime(23,24,25,678);
+  DDT:=EncodeDate(1999,11,12)+EncodeTime(1,2,3,4);
+  SampleFile;
+  AssertEquals('Value, case OK',DT,Ini.ReadDateTime('a','dt',DDT));
+  AssertEquals('Value, key case not OK',DT,Ini.ReadDateTime('a','DT',DDT));
+  AssertEquals('Value, section case not OK',DT,Ini.ReadDateTime('A','dt',DDT));
+  AssertEquals('Value, section not exist',DDT,Ini.ReadDateTime('C','dt',DDT));
+  AssertEquals('Value, key exist as float',DT,Ini.ReadDateTime('a','fdt',DDT));
+end;
+
+procedure TJSONIniTest.TestEraseSection;
+begin
+  SampleFile;
+  Ini.EraseSection('B');
+  Ini.UpdateFile;
+  ReadFile;
+  AssertEquals('No more section',-1,ObjFileContent.IndexOfName('B'));
+end;
+
+procedure TJSONIniTest.TestEraseSectionCaseMismatch;
+begin
+  SampleFile;
+  Ini.EraseSection('b');
+  Ini.UpdateFile;
+  ReadFile;
+  AssertEquals('No more section',-1,ObjFileContent.IndexOfName('B'));
+end;
+
+procedure TJSONIniTest.TestDeleteKey;
+begin
+  SampleFile;
+  Ini.DeleteKey('a','i');
+  Ini.UpdateFile;
+  ReadFile;
+  AssertEquals('No more key',-1,ObjFileContent.Objects['a'].IndexOfName('i'));
+end;
+
+procedure TJSONIniTest.TestDeleteKeySectionCaseMismatch;
+begin
+  SampleFile;
+  Ini.DeleteKey('A','i');
+  Ini.UpdateFile;
+  ReadFile;
+  AssertEquals('No more key',-1,ObjFileContent.Objects['a'].IndexOfName('i'));
+end;
+
+procedure TJSONIniTest.TestDeleteKeyKeyCaseMismatch;
+begin
+  SampleFile;
+  Ini.DeleteKey('a','I');
+  Ini.UpdateFile;
+  ReadFile;
+  AssertEquals('No more key',-1,ObjFileContent.Objects['a'].IndexOfName('i'));
+end;
+
+procedure TJSONIniTest.AssertValue(const aSection,Akey,avalue : string);
+
+Var
+  D : TJSONData;
+
+begin
+  ini.UpdateFile;
+  ReadFile;
+  D:=ObjFileContent.FindPath(asection+'.'+akey);
+  AssertNotNull('Have value at '+asection+'.'+akey,D);
+  AssertEquals('Correct value at '+asection+'.'+akey,AValue,D.AsString);
+end;
+
+procedure TJSONIniTest.NoFileYet;
+
+begin
+  AssertFalse('File not exist yet',FileExists(TestFile));
+end;
+
+procedure TJSONIniTest.HaveFile;
+
+begin
+  AssertTrue('Test file exists',FileExists(TestFile));
+end;
+
+procedure TJSONIniTest.ReLoad;
+begin
+  FreeAndNil(Fini);
+  AssertNotNull(Ini);
+end;
+
+procedure TJSONIniTest.RemoveFile;
+begin
+  if FileExists(TestFile) then
+    AssertTrue('Deleted file',DeleteFile(TestFile));
+end;
+
+procedure TJSONIniTest.TestWriteString;
+begin
+  Ini.WriteString('a','i','string');
+  NoFileYet;
+  AssertValue('a','i','string');
+  Ini.CacheUpdates:=False;
+  Ini.WriteString('a','i','string2');
+  HaveFile;
+  AssertValue('a','i','string2');
+  Reload;
+  AssertEquals('Can read value','string2',Ini.ReadString('a','i',''));
+end;
+
+procedure TJSONIniTest.TestWriteInteger;
+begin
+  Ini.Writeinteger('a','i',2);
+  NoFileYet;
+  AssertValue('a','i','2');
+  Ini.CacheUpdates:=False;
+  Ini.WriteInteger('a','i',3);
+  HaveFile;
+  AssertValue('a','i','3');
+  Reload;
+  AssertEquals('Can read value',3,Ini.ReadInteger('a','i',0));
+end;
+
+procedure TJSONIniTest.TestWriteBoolean;
+begin
+  Ini.WriteBool('a','i',true);
+  NoFileYet;
+  AssertValue('a','i','True');
+  Ini.CacheUpdates:=False;
+  Ini.WriteBool('a','i2',true);
+  HaveFile;
+  AssertValue('a','i2','True');
+  Reload;
+  AssertEquals('Can read value',True,Ini.ReadBool('a','i2',false));
+end;
+
+procedure TJSONIniTest.TestWriteDate;
+Var
+  D : TDateTime;
+begin
+  D:=EncodeDate(2001,2,3);
+  Ini.WriteDate('a','i',D);
+  NoFileYet;
+  AssertValue('a','i','2001-02-03T00:00:00.000');
+  Ini.CacheUpdates:=False;
+  Ini.WriteDate('a','i',D+1);
+  HaveFile;
+  AssertValue('a','i','2001-02-04T00:00:00.000');
+  Reload;
+  AssertEquals('Can read value',D+1,Ini.ReadDate('a','i',0));
+end;
+
+procedure TJSONIniTest.TestWriteDateTime;
+
+Var
+  D : TDateTime;
+
+begin
+  D:=EncodeDate(2001,2,3)+EncodeTime(12,13,14,567);
+  Ini.WriteDateTime('a','i',D);
+  NoFileYet;
+  AssertValue('a','i','2001-02-03T12:13:14.567');
+  Ini.CacheUpdates:=False;
+  Ini.WriteDateTime('a','i',D+1);
+  HaveFile;
+  AssertValue('a','i','2001-02-04T12:13:14.567');
+  Reload;
+  AssertEquals('Can read value',D+1,Ini.ReadDateTime('a','i',0));
+end;
+
+procedure TJSONIniTest.TestWriteTime;
+
+Var
+  D,D2 : TDateTime;
+
+begin
+  D:=EncodeTime(12,13,14,567);
+  D2:=EncodeTime(13,14,15,678);
+  Ini.WriteTime('a','i',D);
+  NoFileYet;
+  AssertValue('a','i','0000-00-00T12:13:14.567');
+  Ini.CacheUpdates:=False;
+  Ini.WriteTime('a','i',D2);
+  HaveFile;
+  AssertValue('a','i','0000-00-00T13:14:15.678');
+  Reload;
+  AssertEquals('Can read value',D2,Ini.ReadTime('a','i',0));
+end;
+
+procedure TJSONIniTest.CreateIni;
+
+Var
+  M : TMemIniFile;
+  D,DT,T : TDateTime;
+
+begin
+  D:=EncodeDate(2001,2,3);
+  T:=EncodeTime(12,13,14,567);
+  DT:=D+T;
+  if FileExists(TestName+'.ini') then
+    DeleteFile(TestName+'.ini');
+  M:=TMemIniFile.Create(TestName+'.ini');
+  try
+    M.WriteString('a','s','c');
+    M.WriteInteger('a','i',2);
+    M.WriteBool('a','b',True);
+    M.WriteInt64('a','i6',Maxint*2);
+    M.WriteDate('a','d',D);
+    M.WriteTime('a','t',T);
+    M.WriteDateTime('a','dt',DT);
+    M.WriteFloat('a','f',1.23);
+    M.UpdateFile;
+  finally
+    M.Free;
+  end;
+end;
+
+procedure TJSONIniTest.TestConvertIni;
+
+Var
+  D,DT,T : TDateTime;
+
+begin
+  D:=EncodeDate(2001,2,3);
+  T:=EncodeTime(12,13,14,567);
+  DT:=D+T;
+  CreateIni;
+  TJSONIniFile.ConvertIni(TestName+'.ini',TestFile,False);
+  AssertEquals('String','c',Ini.ReadString('a','s',''));
+  AssertEquals('Integer',2,Ini.ReadInteger('a','i',1));
+  AssertEquals('Bool',True,Ini.ReadBool('a','b',False));
+  AssertEquals('Int64',Int64(Maxint*2),Ini.ReadInt64('a','i6',Maxint*2));
+  AssertEquals('Date',D, Ini.ReadDate('a','d',0));
+  AssertEquals('Time',T,Ini.ReadTime('a','t',0));
+  AssertEquals('DateTime',DT,Ini.ReadDateTime('a','dt',0));
+  AssertEquals('Float',1.23,Ini.ReadFloat('a','f',0));
+  if FileExists(TestName+'.ini') then
+    DeleteFile(TestName+'.ini');
+end;
+
+procedure TJSONIniTest.TestConvertIniString;
+Var
+  D,DT,T : TDateTime;
+
+begin
+  D:=EncodeDate(2001,2,3);
+  T:=EncodeTime(12,13,14,567);
+  DT:=D+T;
+  CreateIni;
+  TJSONIniFile.ConvertIni(TestName+'.ini',TestFile,True);
+  AssertEquals('String','c',Ini.ReadString('a','s',''));
+  AssertEquals('Integer',2,Ini.ReadInteger('a','i',1));
+  AssertEquals('Bool',True,Ini.ReadBool('a','b',False));
+  AssertEquals('Int64',Int64(Maxint*2),Ini.ReadInt64('a','i6',Maxint*2));
+  AssertEquals('Date',DateToStr(D), Ini.ReadString('a','d',''));
+  AssertEquals('Time',TimeToStr(T),Ini.ReadString('a','t',''));
+  AssertEquals('DateTime',DateTimeToStr(DT),Ini.ReadString('a','dt',''));
+  AssertEquals('Float',1.23,Ini.ReadFloat('a','f',0));
+  if FileExists(TestName+'.ini') then
+    DeleteFile(TestName+'.ini');
+end;
+
+initialization
+  RegisterTest(TJSONIniTest);
+end.
+

+ 2422 - 0
compiler/packages/fcl-json/tests/tcjsontocode.pp

@@ -0,0 +1,2422 @@
+unit tcjsontocode;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, fpjsontopas;
+
+type
+
+  { TTestGenCode }
+
+  TTestGenCode= class(TTestCase)
+  private
+    FPos : Integer;
+    FGen: TJSONToPascal;
+    procedure AssertDelphiLoadArray(AElementType, AJSONtype: String);
+    procedure AssertDelphiPropertyAssignmentLoop;
+    procedure AssertDestructorImplementation(AClassName: String; ObjectFields: array of string);
+    procedure AssertLine(Msg: String; AExpected: String);
+    procedure GenCode(AJSON: String);
+    class function GetDataName(IsDelphi: Boolean): string;
+    function NextLine: String;
+    function Pos(const What, Where: String): Integer;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure AssertArrayCreator(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
+    procedure AssertArraySaver(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
+    procedure AssertArrayCreatorImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
+    procedure AssertArraySaverImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
+    procedure AssertLoadArray(AElementType, AJSONtype: String; IsDelphi : Boolean = False);
+    procedure AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
+    procedure AssertPropertyAssignmentLoop;
+    procedure AssertType;
+    procedure AssertClassComment(const Msg, AName: String);
+    procedure AssertLoadConstructorDeclaration(AType: String);
+    procedure AssertLoaderDeclaration(AType: String);
+    procedure AssertSaverDeclaration;
+    procedure AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
+    procedure AssertLoadConstructorImplementationStart(Const ATypeName, ADataName: String);
+    procedure AssertLoaderImplementationStart(Const ATypeName, ADataName: String; IsDelphi : Boolean = False);
+    procedure AssertSaverImplementationStart(Const ATypeName: String; IsDelphi : Boolean = False);
+    procedure AssertArrayLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
+    procedure AssertObjectLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
+    Procedure AssertUnitHeader;
+    Procedure AssertBegin;
+    Procedure AssertEnd(Const Msg : String = '');
+    Procedure AssertUnitEnd;
+    Procedure AssertImplementation;
+    procedure AssertProperty(const AName, AType: String; Setter : Boolean = False);
+    procedure AssertSetter(const AName, AType: String);
+    Procedure AssertClassHeader(Const AName : String; AParentName : String);
+    Procedure AssertSetterImplementation(Const AClassType,AName,AType : String; IsObject : Boolean = False);
+    Procedure AssertVisibility(Const AVisibility : String);
+    Procedure AssertDestructor;
+    Procedure AssertField(Const AName,AType : String; Prefix : String = '');
+    Procedure AssertArrayType(Const AName,AItemType : String);
+    Procedure AssertPropertyMap(Const APath,ATypeName,APropertyName,AParentTypeName : String);
+    Property Gen : TJSONToPascal Read FGen;
+  published
+    procedure TestEmpty;
+    Procedure TestSimple;
+    Procedure TestClassName;
+    Procedure TestParentClassName;
+    Procedure TestIntegerProperty;
+    Procedure Test2IntegersProperty;
+    Procedure TestBooleanProperty;
+    Procedure TestStringProperty;
+    Procedure TestFloatProperty;
+    Procedure TestInt64Property;
+    Procedure TestPropertySetter;
+    Procedure TestObjectProperty;
+    Procedure TestObjectPropertySetter;
+    Procedure TestObjectPropertySuffix;
+    Procedure TestObjectPropertySkip;
+    Procedure TestObjectPropertyRecurse;
+    Procedure TestObjectPropertyRecurseSuffix;
+    Procedure TestObjectPropertyRecurseSkip;
+    Procedure TestObjectPropertyRecurseSkipB;
+    Procedure TestStringArrayProperty;
+    Procedure TestIntegerArrayProperty;
+    Procedure TestBooleanArrayProperty;
+    Procedure TestFloatArrayProperty;
+    Procedure TestInt64ArrayProperty;
+    Procedure TestStringArrayPropertySuffix;
+    Procedure TestObjectArrayProperty;
+    procedure TestObjectArrayPropertySuffix;
+    procedure TestArrayArrayProperty;
+    procedure TestObjectArrayArrayProperty;
+    Procedure TestLoadIntegerProperty;
+    Procedure TestLoad2IntegersProperty;
+    Procedure TestLoadIntegerWithErrorProperty;
+    Procedure TestLoadIntegerCaseInsensitiveProperty;
+    Procedure TestLoadStringProperty;
+    Procedure TestLoadBooleanProperty;
+    Procedure TestLoadInt64Property;
+    Procedure TestLoadFloatProperty;
+    Procedure TestLoadObjectProperty;
+    Procedure TestLoadStringArrayProperty;
+    Procedure TestLoadBooleanArrayProperty;
+    Procedure TestLoadIntegerArrayProperty;
+    Procedure TestLoadInt64ArrayProperty;
+    Procedure TestLoadFloatArrayProperty;
+    Procedure TestLoadObjectArrayProperty;
+    Procedure TestLoadDelphiIntegerProperty;
+    Procedure TestLoadDelphi2IntegersProperty;
+    Procedure TestLoadDelphiIntegerWithErrorProperty;
+    Procedure TestLoadDelphiIntegerCaseInsensitiveProperty;
+    Procedure TestLoadDelphiStringProperty;
+    Procedure TestLoadDelphiBooleanProperty;
+    Procedure TestLoadDelphiInt64Property;
+    Procedure TestLoadDelphiFloatProperty;
+    procedure TestLoadDelphiObjectProperty;
+    Procedure TestLoadDelphiStringArrayProperty;
+    Procedure TestLoadDelphiBooleanArrayProperty;
+    Procedure TestLoadDelphiIntegerArrayProperty;
+    Procedure TestLoadDelphiInt64ArrayProperty;
+    Procedure TestLoadDelphiFloatArrayProperty;
+    procedure TestLoadDelphiObjectArrayProperty;
+    Procedure TestSaveIntegerProperty;
+    Procedure TestSave2IntegersProperty;
+    Procedure TestSaveStringProperty;
+    Procedure TestSaveBooleanProperty;
+    Procedure TestSaveInt64Property;
+    Procedure TestSaveFloatProperty;
+    Procedure TestSaveObjectProperty;
+    Procedure TestSaveStringArrayProperty;
+    Procedure TestSaveBooleanArrayProperty;
+    Procedure TestSaveIntegerArrayProperty;
+    Procedure TestSaveInt64ArrayProperty;
+    Procedure TestSaveFloatArrayProperty;
+    Procedure TestSaveObjectArrayProperty;
+    Procedure TestSaveDelphiIntegerProperty;
+    Procedure TestSaveDelphi2IntegersProperty;
+    Procedure TestSaveDelphiStringProperty;
+    Procedure TestSaveDelphiBooleanProperty;
+    Procedure TestSaveDelphiInt64Property;
+    Procedure TestSaveDelphiFloatProperty;
+    Procedure TestSaveDelphiObjectProperty;
+    Procedure TestSaveDelphiStringArrayProperty;
+    Procedure TestSaveDelphiBooleanArrayProperty;
+    Procedure TestSaveDelphiIntegerArrayProperty;
+    Procedure TestSaveDelphiInt64ArrayProperty;
+    Procedure TestSaveDelphiFloatArrayProperty;
+    Procedure TestSaveDelphiObjectArrayProperty;
+  end;
+
+Var
+  TestUnitDir : String;
+
+implementation
+
+procedure TTestGenCode.SetUp;
+begin
+  FGen:=TJSONToPascal.Create(Nil);
+end;
+
+procedure TTestGenCode.TearDown;
+begin
+  FreeAndNil(FGen)
+end;
+
+function TTestGenCode.NextLine: String;
+
+begin
+  Result:='';
+  While (Result='') do
+    begin
+    Inc(FPos);
+    AssertTrue('In scope',FPos<FGen.Code.Count);
+    Result:=Trim(FGen.Code[FPos]);
+    end;
+end;
+
+procedure TTestGenCode.AssertUnitHeader;
+
+Var
+  S: String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Have unit',Pos('unit ',S)=1);
+  S:=NextLine;
+  AssertTrue('Have interface',Pos('interface',S)=1);
+  S:=NextLine;
+  AssertTrue('Have uses',Pos('uses ',S)=1);
+  S:=NextLine;
+  AssertTrue('Type line',Pos('Type',S)=1);
+end;
+
+procedure TTestGenCode.AssertBegin;
+begin
+  AssertTrue('Have begin',pos('begin',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertEnd(const Msg: String);
+begin
+  AssertTrue('Have end:'+Msg,pos('end;',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertUnitEnd;
+begin
+  AssertTrue('Have end.',pos('end.',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertImplementation;
+begin
+  AssertTrue('Have implementation',CompareText(NextLine,'implementation')=0);
+end;
+
+function TTestGenCode.Pos(const What, Where: String): Integer;
+
+begin
+  Result:=system.Pos(lowercase(what),lowercase(where));
+end;
+
+procedure TTestGenCode.AssertClassComment(const Msg,AName: String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment start',Pos('{ --',S)>0);
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment class nam',Pos(AName,S)>0);
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment end',Pos('}',S)>0);
+end;
+
+procedure TTestGenCode.AssertClassHeader(const AName: String; AParentName: String);
+
+Var
+  P : Integer;
+  S : String;
+
+begin
+  AssertClassComment('Class declarationheader for '+AName,AName);
+  S:=NextLine;
+  P:=Pos(AName+' = class(',S);
+  AssertTrue('class type ',P>0);
+  P:=Pos(AParentName+')',S);
+  AssertTrue('Class parent type ',P>0);
+  AssertVisibility('private');
+end;
+
+procedure TTestGenCode.AssertSetterImplementation(const AClassType, AName,
+  AType: String; IsObject: Boolean);
+
+Var
+  S,PS : String;
+  P : Integer;
+
+begin
+  S:=NextLine;
+  PS:='Procedure '+AClassType+'.Set'+Aname+'(AValue';
+  AssertTrue('Have declaration start',Pos(PS,S)>0);
+  Delete(S,1,Length(PS));
+  P:=Pos(':',S);
+  AssertTrue('Have colon' ,p>0);
+  Delete(S,1,P);
+  AssertTrue('Have type',Pos(AType,S)>0);
+  AssertTrue('Have );',Pos(');',S)>0);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+  AssertBegin;
+  AssertTrue('Have change check',Pos('if ('+Gen.FieldPrefix+AName+'=AValue) then exit;',NextLine)>0);
+  if IsObject then
+    AssertTrue('Have free of previous value',Pos('FreeAndNil('+Gen.FieldPrefix+AName+');',NextLine)>0);
+  AssertTrue('Have Assignment',Pos(Gen.FieldPrefix+AName+':=AValue;',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertVisibility(const AVisibility: String);
+
+begin
+  AssertTrue('Have visibility section '+AVisibility,Pos(AVisibility,NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDestructor;
+begin
+  AssertTrue('Have destructor declaration',Pos('Destructor Destroy; override;',NextLine)>0);
+end;
+
+
+procedure TTestGenCode.AssertDestructorImplementation(AClassName: String;
+  ObjectFields: array of string);
+
+Var
+  F : String;
+
+begin
+  AssertTrue('Have destructor implementation',Pos(Format('Destructor %s.Destroy;',[AClassName]),NextLine)>0);
+  AssertBegin;
+  For F in ObjectFields do
+    AssertTrue('Have destructor for F'+F,Pos('FreeAndNil(F'+F+');',NextLine)>0);
+  AssertTrue('Have inherited call'+F,Pos('Inherited;',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertField(const AName, AType: String; Prefix : String = '');
+
+Var
+  F,S : String;
+  P : Integer;
+
+begin
+  F:=Prefix;
+  if F='' then
+    F:='F';
+  S:=NextLine;
+  AssertTrue('Field Name',Pos(F+AName,S)=1);
+  P:=Pos(':',S);
+  AssertTrue('Colon after field name',P>Length(F+AName));
+  AssertTrue('Field type after colon',Pos(AType,S)>P);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertSetter(const AName, AType: String);
+
+Var
+  N,S,PD : String;
+  P,p2 : Integer;
+
+begin
+  S:=NextLine;
+  N:='Setter declaration for '+AName+' : ';
+  PD:='Procedure Set'+AName;
+  AssertTrue(N+'Setter name',Pos(PD,S)=1);
+  P:=Pos('(',S);
+  AssertTrue(N+'( after parameter name',P>Length(PD));
+  P:=Pos(':',S);
+  AssertTrue(N+'Colon after parameter name',P>Length(PD));
+  Delete(S,1,P);
+  P2:=Pos(AType,S);
+  AssertTrue(N+'Field type after colon '+AType+' : '+S,P2>0);
+  P:=Pos(');',S);
+  AssertTrue(N+'); type after parameter type',P>P2);
+  P2:=Pos('virtual',S);
+  AssertTrue(N+'virtual after ); ',P2>P);
+  AssertTrue(N+'Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertArrayType(const AName, AItemType: String);
+
+Var
+  P,p2 : Integer;
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Type Name',Pos(AName,S)=1);
+  P:=Pos('=',S);
+  AssertTrue('Equal token after type Name',P>Pos(AName,S));
+  P2:=Pos('Array of',S);
+  AssertTrue('Array of after Equal token after type Name',P2>P);
+  P:=Pos(AItemType,S);
+  AssertTrue('Item type name after array of',P>P2);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertPropertyMap(const APath, ATypeName, APropertyName,
+  AParentTypeName: String);
+
+Var
+  M : TPropertyMapItem;
+
+begin
+  M:=Gen.PropertyMap.FindPath(APath);
+  AssertNotNull('Have property map "'+APath+'"',M);
+  AssertEquals('Have type name ',ATypeName,M.TypeName);
+  AssertEquals('Have property name ',APropertyName,M.PropertyName);
+  AssertEquals('Have parent type name ',AParentTypeName,M.ParentTypeName);
+end;
+
+procedure TTestGenCode.AssertProperty(const AName, AType: String; Setter : Boolean = False);
+
+Var
+  S : String;
+  P,P2 : Integer;
+
+begin
+  S:=NextLine;
+  AssertTrue('Property Name',Pos('Property '+AName,S)=1);
+  P:=Pos(':',S);
+  AssertTrue('Colon after property name',P>Length('Property '+AName));
+  P2:=Pos(AType,S);
+  AssertTrue('Field type after colon',P2>P);
+  P:=pos(' read ',S);
+  AssertTrue('Read specifier after type ',P>P2);
+  P2:=Pos('F'+AName,S);
+  AssertTrue('Field name for read specifier',P2>P);
+  P:=pos(' write ',S);
+  AssertTrue('Write specifier after type ',P>P2);
+  if Setter Then
+    P2:=Pos('write Set'+AName,S)
+  else
+    P2:=Pos('write F'+AName,S);
+  AssertTrue('Field name for write specifier',P2>P);
+
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+
+procedure TTestGenCode.GenCode(AJSON : String);
+
+Var
+  F : Text;
+
+begin
+  Gen.JSON:=AJSON;
+  Gen.DestUnitName:='u'+TestName;
+  Gen.Execute;
+  if (TestUnitDir<>'') then
+    begin
+    Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.pp');
+    Rewrite(F);
+    Writeln(F,'// ',Self.TestName);
+    Writeln(F,Gen.Code.Text);
+    Close(F);
+    Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.json');
+    Rewrite(F);
+    Writeln(F,AJSON);
+    Close(F);
+    end
+  else
+    begin
+    Writeln('// ',Self.TestName);
+    Writeln('(* JSON: '+AJSON+' *)');
+    Writeln(Gen.Code.Text);
+    end;
+
+  FPos:=-1;
+end;
+
+procedure TTestGenCode.TestEmpty;
+begin
+  AssertNotNull('Have generator',Gen);
+  AssertNotNull('Generator property map exists',Gen.PropertyMap);
+  AssertNotNull('Generator property code exists',Gen.Code);
+  AssertNull('Generator JSON empty',Gen.JSONData);
+  AssertNull('Generator JSON stream empty',Gen.JSONStream);
+  AssertEquals('Generator JSON empty','',Gen.JSON);
+  AssertEquals('Generator property map empty',0,Gen.PropertyMap.Count);
+end;
+
+procedure TTestGenCode.TestSimple;
+begin
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+end;
+
+procedure TTestGenCode.TestClassName;
+begin
+  Gen.PropertyMap.AddPath('','TSomeObject');
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TSomeObject','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TSomeObject','','TObject');
+end;
+
+procedure TTestGenCode.TestParentClassName;
+begin
+  Gen.PropertyMap.AddPath('','TSomeObject');
+  Gen.DefaultParentName:='TMyObject';
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TSomeObject','TMyObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TSomeObject','','TMyObject');
+end;
+
+procedure TTestGenCode.TestIntegerProperty;
+begin
+  GenCode('{ "a" : 1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertProperty('a','integer');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.Test2IntegersProperty;
+begin
+  GenCode('{ "a" : 1, "b" : 2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertProperty('a','integer');
+  AssertProperty('b','integer');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestBooleanProperty;
+begin
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertProperty('a','boolean');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestStringProperty;
+begin
+  GenCode('{ "a" : "abce" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertProperty('a','string');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestFloatProperty;
+begin
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertProperty('a','double');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestInt64Property;
+begin
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','int64');
+  AssertVisibility('public');
+  AssertProperty('a','int64');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestPropertySetter;
+begin
+  Gen.Options:=[jpoUseSetter];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','int64');
+  AssertVisibility('protected');
+  AssertSetter('A','int64');
+  AssertVisibility('public');
+  AssertProperty('a','int64',True);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSetterImplementation('TMyObject','a','int64');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestObjectProperty;
+begin
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Comment for class TA','Ta');
+  AssertClassComment('Comment for class TMyObject','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySetter;
+begin
+  Gen.Options:=[jpoUseSetter];
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertVisibility('protected');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('protected');
+  AssertSetter('a','Ta');
+  AssertVisibility('Public');
+  AssertDestructor;
+  AssertProperty('a','Ta',True);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Comment for class TA','Ta');
+  AssertClassComment('Comment for class TMyObject','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSetterImplementation('TMyObject','a','Ta',True);
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TAType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySkip;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  Gen.PropertyMap.AddPath('a','me').SkipType:=true;
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','me');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','me','a','');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurse;
+begin
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TAB','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TA','TObject');
+  AssertField('b','TaB');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','TaB');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+  AssertPropertyMap('a.b','Tab','b','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TABType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TAType','TObject');
+  AssertField('b','TaBType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','TaBType');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','TObject');
+  AssertPropertyMap('a.b','TabType','b','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSkip;
+begin
+  Gen.PropertyMap.AddPath('a','me').SkipType:=true;
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','me');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','me','a','');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSkipB;
+begin
+  Gen.PropertyMap.AddPath('a.b','me').SkipType:=true;
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertField('b','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','me');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+  AssertPropertyMap('a.b','me','b','');
+end;
+
+procedure TTestGenCode.TestStringArrayProperty;
+begin
+  GenCode('{ "a" : [ "" ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','string');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','String','','');
+end;
+
+procedure TTestGenCode.TestIntegerArrayProperty;
+begin
+  GenCode('{ "a" : [ 1 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','integer');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Integer','','');
+end;
+
+procedure TTestGenCode.TestBooleanArrayProperty;
+begin
+  GenCode('{ "a" : [ true ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Boolean');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Boolean','','');
+end;
+
+procedure TTestGenCode.TestFloatArrayProperty;
+begin
+  GenCode('{ "a" : [ 1.2 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Double');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Double','','');
+end;
+
+procedure TTestGenCode.TestInt64ArrayProperty;
+begin
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Int64');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Int64','','');
+end;
+
+procedure TTestGenCode.TestStringArrayPropertySuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : [ "" ] }');
+  AssertUnitHeader;
+  AssertArrayType('TaType','string');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','');
+  AssertPropertyMap('a[0]','String','','');
+end;
+
+procedure TTestGenCode.TestObjectArrayProperty;
+begin
+  GenCode('{ "a" : [ {} ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','TObject');
+end;
+
+procedure TTestGenCode.TestObjectArrayPropertySuffix;
+
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : [ {} ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItemType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('TaType','TaItemType');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','');
+  AssertPropertyMap('a[0]','TaItemType','','TObject');
+end;
+
+procedure TTestGenCode.TestArrayArrayProperty;
+begin
+  GenCode('{ "a" : [ [ "" ] ] }');
+  AssertUnitHeader;
+  AssertArrayType('TaItem','String');
+  AssertArrayType('Ta','TaItem');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','');
+  AssertPropertyMap('a[0][0]','String','','');
+end;
+
+procedure TTestGenCode.TestObjectArrayArrayProperty;
+begin
+  GenCode('{ "a" : [ [ {} ] ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItemItem','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('TaItem','TaItemItem');
+  AssertArrayType('Ta','TaItem');
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','');
+  AssertPropertyMap('a[0][0]','TaItemItem','','TObject');
+end;
+
+procedure TTestGenCode.AssertLoadConstructorDeclaration(AType: String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Load Constructor declaration in '+S,Pos('Constructor CreateFromJSON(AJSON : '+AType+'); virtual;',S)>0);
+end;
+
+procedure TTestGenCode.AssertLoaderDeclaration(AType : String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('LoadFromJSON declaration in '+S,Pos('Procedure LoadFromJSON(AJSON : '+AType+'); virtual;',S)>0);
+end;
+
+procedure TTestGenCode.AssertSaverDeclaration;
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('SaveToJSON function declaration in '+S,Pos('Function SaveToJSON : TJSONObject;',S)>0);
+  S:=NextLine;
+  AssertTrue('SaveToJSON procedure declaration in '+S,Pos('Procedure SaveToJSON(AJSON : TJSONObject)',S)>0);
+end;
+
+procedure TTestGenCode.AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
+
+begin
+  if Not IsDelphi then
+    AssertEnd('Case');// Case
+  AssertEnd('for');// For
+  AssertEnd('procedure');// Routine
+end;
+
+procedure TTestGenCode.AssertArrayLoaderImplementationStart(const ATypeName,
+  ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
+
+Var
+  S : String;
+begin
+  S:=NextLine;
+  AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertPropertyAssignmentLoop;
+
+begin
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have P enum',Pos('E : TJSONEnum;',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Have E for enum',Pos('For E in AJSON do',NextLine)>0);
+  AssertBegin;
+  if (jpoLoadCaseInsensitive in Gen.Options) then
+    AssertTrue('Have E for enum',Pos('case LowerCase(E.key) of',NextLine)>0)
+  else
+    AssertTrue('Have E for enum',Pos('case E.key of',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDelphiPropertyAssignmentLoop;
+
+Var
+  S : String;
+
+begin
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have pair',Pos('P : TJSONPair;',NextLine)>0);
+  AssertTrue('Have obj',Pos('O : TJSONObject;',NextLine)>0);
+  AssertTrue('Have Propertyname var',Pos('PN : String;',NextLine)>0);
+  AssertBegin;
+  S:=NextLine;
+  AssertTrue('Have JSONObject check in '+S,Pos('not (AJSON is TJSONObject)',S)>0);
+  if jpoUnknownLoadPropsError in gen.Options then
+    AssertTrue('Have raise statement',Pos('Raise EJSONException',NextLine)>0);
+  AssertTrue('Have typecast',Pos('O:=AJSON as TJSONObject',NextLine)>0);
+  AssertTrue('Have P for enum',Pos('For P in O do',NextLine)>0);
+  AssertBegin;
+  if jpoLoadCaseInsensitive in Gen.Options then
+    AssertTrue('Have case insensitive propertyname assign',Pos('PN:=LowerCase(P.JSONString.Value)',NextLine)>0)
+  else
+    AssertTrue('Have propertyname assign',Pos('PN:=P.JSONString.Value',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertObjectLoaderImplementationStart(const ATypeName,
+  ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
+Var
+  S : String;
+begin
+  S:=NextLine;
+  AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertSaverImplementationStart(const ATypeName: String;
+  IsDelphi: Boolean);
+
+Var
+  S,N : String;
+
+begin
+  N:='SaveToJSONFunction '+ATypeName+' : ';
+  S:=NextLine;
+  AssertTrue(N+'header',Pos('Function  '+ATypeName+'.SaveToJSON : TJSONObject;',S)>0);
+  AssertBegin;
+  AssertTrue(N+'Create',Pos('Result:=TJSONObject.Create',NextLine)>0);
+  AssertTrue(N+'Try',Pos('Try',NextLine)>0);
+  AssertTrue(N+'Save',Pos('SaveToJSON(Result);',NextLine)>0);
+  AssertTrue(N+'except',Pos('except',NextLine)>0);
+  AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
+  AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'proc header',Pos('Procedure '+ATypeName+'.SaveToJSON(AJSON : TJSONObject);',NextLine)>0);
+  AssertBegin;
+end;
+
+
+procedure TTestGenCode.AssertLoaderImplementationStart(const ATypeName,
+  ADataName: String; IsDelphi : Boolean = False);
+
+begin
+  AssertTrue(Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',NextLine)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertLoadConstructorImplementationStart(const ATypeName,
+  ADataName: String);
+
+begin
+  AssertTrue('Have constructor call',Pos('Constructor '+ATypeName+'.CreateFromJSON(AJSON : '+ADataName+');',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Call create constructor',Pos('create();',NextLine)>0);
+  AssertTrue('Call LoadFromJSON',Pos('LoadFromJSON(AJSON);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.TestLoadIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestLoad2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadIntegerWithErrorProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoUnknownLoadPropsError];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have case else',Pos('else',NextLine)>0);
+  AssertTrue('Have raise statement', Pos('Raise EJSON.CreateFmt',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadIntegerCaseInsensitiveProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoLoadCaseInsensitive];
+  GenCode('{ "A" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('A','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('A','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData',False);
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('A:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('A','Integer','A','');
+end;
+
+procedure TTestGenCode.TestLoadStringProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" string property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" string property set', Pos('a:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestLoadBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" boolean property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" boolean property set', Pos('a:=E.Value.AsBoolean;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestLoadInt64Property;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" Int64 property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" Int64 property set', Pos('a:=E.Value.AsInt64;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestLoadFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Double');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','Double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" Double property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" Double property set', Pos('a:=E.Value.AsFloat;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestLoadObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertLoadConstructorImplementationStart('Ta','TJSONData');
+  AssertLoaderImplementationStart('Ta','TJSONData');
+  AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
+  AssertTrue('Have "a" object property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(E.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.AssertArrayCreator(const ArrayTypeName,
+  AElementType: String; IsDelphi: Boolean);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Have array creator in '+S,Pos('Function Create'+ArrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName,S)>0);
+end;
+
+procedure TTestGenCode.AssertArraySaver(const ArrayTypeName,
+  AElementType: String; IsDelphi: Boolean);
+
+Var
+  E,S : String;
+
+begin
+  S:=NextLine;
+  E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
+  AssertTrue('Have proc array saver in '+S,Pos(E,S)>0);
+  S:=NextLine;
+  E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
+  AssertTrue('Have func array saver in '+S,Pos(E,S)>0);
+end;
+
+procedure TTestGenCode.AssertArrayCreatorImplementation(const ArrayTypeName,
+  AElementType: String; AObjectName: String; IsDelphi: Boolean);
+
+Var
+  S,E,AN : String;
+
+begin
+  S:=NextLine;
+  E:='Function Create'+ARrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName;
+  AssertTrue('Have array creator header '+S+'Expected : '+E ,Pos(E,S)>0);
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
+  if IsDelphi then
+    begin
+    AssertTrue('Have Array var',Pos('A : TJSONArray;',NextLine)>0);
+    AN:='A'
+    end
+  else
+    AN:='AJSON';
+  AssertBegin;
+  if IsDelphi then
+    AssertTrue('Have Array assignnment',Pos('A:=AJSON as TJSONArray;',NextLine)>0);
+  AssertTrue('Have array setlength ',Pos('SetLength(Result,'+AN+'.Count);',NextLine)>0);
+  AssertTrue('Have loop ',Pos('for i:=0 to '+AN+'.Count-1 do',NextLine)>0);
+  if AObjectName='' then
+    begin
+    if IsDelphi then
+      AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].GetValue<'+AElementType+'>;',NextLine)>0)
+    else
+      AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].'+AElementType+';',NextLine)>0)
+    end
+  else
+    AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AObjectName+'.CreateFromJSON('+AN+'.Items[i]);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertLine(Msg : String; AExpected : String);
+
+Var
+  N,DMsg : String;
+
+begin
+  N:=NextLine;
+  DMsg:=Msg+', Expected: "'+AExpected+'", Actual: "'+N+'"';
+  AssertTrue(Dmsg,Pos(AExpected,N)>0);
+end;
+
+procedure TTestGenCode.AssertArraySaverImplementation(const ArrayTypeName,
+  AElementType: String; AObjectName: String; IsDelphi: Boolean);
+Var
+  N,S,E,AN : String;
+
+begin
+  N:=ArrayTypeName+'Saver : ';
+  S:=NextLine;
+  E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
+  AssertTrue(N+'header',Pos(E,S)>0);
+  AssertBegin;
+  AssertTrue(N+'Create',Pos('Result:=TJSONArray.Create',NextLine)>0);
+  AssertTrue(N+'Try',Pos('Try',NextLine)>0);
+  S:=NextLine;
+  E:='Save'+ArrayTypeName+'ToJSON(AnArray,Result);';
+  AssertTrue(N+'Save',Pos(E,S)>0);
+  AssertTrue(N+'except',Pos('except',NextLine)>0);
+  AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
+  AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  S:=NextLine;
+  E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
+  AssertTrue('Have array saver header '+S+'Expected : '+E ,Pos(E,S)>0);
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Have loop ',Pos('for i:=0 to Length(AnArray)-1 do',NextLine)>0);
+  if AObjectName='' then
+    AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add(AnArray[i]);')
+{  else if AObjectName='' then
+    AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add('+AN+'[i]);')}
+  else
+     AssertTrue('Have element assignment : '+AElementType,Pos('AJSONArray.Add(AnArray[i].SaveToJSON);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertType;
+
+begin
+  AssertTrue('Have Type keyword',Pos('Type',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDelphiLoadArray(AElementType, AJSONtype : String);
+
+begin
+  AssertUnitHeader;
+  AssertArrayType('Ta',AElementType);
+  AssertArrayCreator('Ta',AElementType,true);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArrayCreatorImplementation('Ta',AJSONType,'',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertArrayLoaderImplementationStart('TMyObject','TJSONValue','a','Ta',AJSONType);
+  AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+class function TTestGenCode.GetDataName(IsDelphi: Boolean): string;
+
+begin
+  if IsDelphi then
+    Result:='TJSONValue'
+  else
+    Result:='TJSONData';
+end;
+
+procedure TTestGenCode.AssertLoadArray(AElementType, AJSONtype: String;
+  IsDelphi: Boolean = False);
+
+Var
+  DN : String;
+
+begin
+  AssertUnitHeader;
+  DN:=GetDataName(IsDelphi);
+  AssertArrayType('Ta',AElementType);
+  AssertArrayCreator('Ta',AElementType,IsDelphi);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration(DN);
+  AssertLoaderDeclaration(DN);
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArrayCreatorImplementation('Ta',AJSONType,'',IsDelphi);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject',DN);
+  AssertArrayLoaderImplementationStart('TMyObject',DN,'a','Ta',AJSONType,isDelphi);
+  if IsDelphi then
+    begin
+    AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
+    AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
+    end
+  else
+    begin
+    AssertTrue('Have "a" array property case',Pos('''a'':',NextLine)>0);
+    AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
+    end;
+  AssertLoaderImplementationEnd(IsDelphi);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
+
+Var
+  DN : String;
+
+begin
+  AssertUnitHeader;
+  DN:=GetDataName(IsDelphi);
+  AssertArrayType('Ta',AElementType);
+  AssertArraySaver('Ta',AElementType,IsDelphi);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArraySaverImplementation('Ta',AJSONType,'',IsDelphi);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  if IsDelphi then
+    AssertTrue('Array save statement', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0)
+  else
+    AssertTrue('Array save statement', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Saver');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestLoadStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertLoadArray('string','AsString');
+end;
+
+procedure TTestGenCode.TestLoadBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ true ] }');
+  AssertLoadArray('boolean','AsBoolean');
+end;
+
+procedure TTestGenCode.TestLoadIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertLoadArray('Integer','AsInteger');
+end;
+
+procedure TTestGenCode.TestLoadInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertLoadArray('Int64','AsInt64');
+end;
+
+procedure TTestGenCode.TestLoadFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 12.34 ] }');
+  AssertLoadArray('Double','AsFloat');
+end;
+
+procedure TTestGenCode.TestLoadObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArrayCreator('Ta','TaItem');
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertLoadConstructorImplementationStart('TAItem','TJSONData');
+  AssertLoaderImplementationStart('TaItem','TJSONData');
+  AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertArrayCreatorImplementation('Ta','','TaItem');
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
+  AssertTrue('Have "a" stringarray property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+
+procedure TTestGenCode.TestLoadDelphiIntegerProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphi2IntegersProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon', Pos(';',S)=0);
+  AssertTrue('Have else  "b" integer property case ',Pos('Else If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerWithErrorProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoUnknownLoadPropsError];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon for a', Pos(';',S)=0);
+  AssertTrue('Have "b" integer property case ',Pos('If (PN=''b'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon for b', Pos(';',S)=0);
+  AssertTrue('Have case else',Pos('else',NextLine)>0);
+  AssertTrue('Have raise statement', Pos('Raise EJSONException.CreateFmt',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerCaseInsensitiveProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoLoadCaseInsensitive];
+  GenCode('{ "A" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('A','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('A','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "A" integer property set', Pos('A:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('A','Integer','A','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiStringProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Boolean>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiInt64Property;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Int64>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Double');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','Double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Double>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertLoadConstructorImplementationStart('Ta','TJSONValue');
+  AssertLoaderImplementationStart('Ta','TJSONValue',True);
+  AssertTrue('Have "b" string property case',Pos('If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
+  AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(P.JSONValue);',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestLoadDelphiObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArrayCreator('Ta','TaItem',True);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertLoadConstructorImplementationStart('TAItem','TJSONValue');
+  AssertLoaderImplementationStart('TaItem','TJSONValue',True);
+  AssertTrue('Have "b" object property case',Pos('If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" object property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertArrayCreatorImplementation('Ta','','TaItem',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
+  AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestSaveIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestSave2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('Have "b" integer property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestSaveStringProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestSaveBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Boolean');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" boolean property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestSaveInt64Property;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" int64 property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestSaveFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1.2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+
+end;
+
+procedure TTestGenCode.TestSaveObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertSaverImplementationStart('Ta');
+  AssertTrue('Have "b" property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
+  AssertTrue('Have "a" object property save', Pos('AJSON.Add(''a'',a.SaveToJSON);',NextLine)>0);
+  AssertEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestSaveStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertSaveArray('string','');
+end;
+
+procedure TTestGenCode.TestSaveBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ true ] }');
+  AssertSaveArray('boolean','');
+end;
+
+procedure TTestGenCode.TestSaveIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertSaveArray('Integer','');
+end;
+
+procedure TTestGenCode.TestSaveInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertSaveArray('Int64','');
+end;
+
+procedure TTestGenCode.TestSaveFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 1.23] }');
+  AssertSaveArray('Double','');
+end;
+
+procedure TTestGenCode.TestSaveObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArraySaver('Ta','TaItem');
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertSaverImplementationStart('TaItem');
+  AssertTrue('Have "b" string property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertArraySaverImplementation('Ta','','TaItem');
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" array property save', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Loader TMyObject');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphi2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('Have "b" integer property save', Pos('AJSON.AddPair(''b'',TJSONNumber.Create(b));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiStringProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" string property save', Pos('AJSON.AddPair(''a'',TJSONString.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Boolean');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" Boolean property save', Pos('AJSON.AddPair(''a'',TJSONBoolean.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiInt64Property;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" int64 property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiFloatProperty;
+Var
+  S : String;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1.2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  S:=NextLine;
+  AssertTrue('Have "a" float property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',S)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiObjectProperty;
+Var
+  S : String;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertSaverImplementationStart('Ta');
+  AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
+  AssertEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" object property save', Pos('AJSON.AddPair(''a'',a.SaveToJSON);',S)>0);
+  AssertEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestSaveDelphiStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertSaveArray('string','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ true ] }');
+  AssertSaveArray('boolean','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertSaveArray('Integer','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertSaveArray('Int64','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 1.23] }');
+  AssertSaveArray('Double','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArraySaver('Ta','TaItem',True);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertSaverImplementationStart('TaItem',True);
+  AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertArraySaverImplementation('Ta','','TaItem',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" array property save', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Loader TMyObject');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertLoadArray('string','String',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ true ] }');
+  AssertLoadArray('boolean','Boolean',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 12 ] }');
+  AssertLoadArray('integer','Integer',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertLoadArray('int64','Int64',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 1.1 ] }');
+  AssertLoadArray('double','Double',True);
+end;
+
+
+initialization
+
+  RegisterTest(TTestGenCode);
+end.
+

+ 1007 - 0
compiler/packages/fcl-json/tests/testcomps.pp

@@ -0,0 +1,1007 @@
+unit testcomps;
+
+interface
+
+uses classes, sysutils;
+
+Type
+  TEmptyComponent = Class(TComponent)
+  end;
+
+  // Simple integer, fits in 1 byte
+  TIntegerComponent = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 2 bytes
+  TIntegerComponent2 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 3 bytes
+  TIntegerComponent3 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, Default value. (set)
+  TIntegerComponent4 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple integer, Default value. (not set)
+  TIntegerComponent5 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple Int64 property fits in a single byte.
+  TInt64Component = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 2 bytes.
+  TInt64Component2 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 3 bytes.
+  TInt64Component3 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 4 bytes.
+  TInt64Component4 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Int64 property with default, set.
+  TInt64Component5 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // Int64 property with default, not set.
+  TInt64Component6 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // String property.
+  TStringComponent = Class(TComponent)
+  private
+    F: String;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // String property, empty
+  TStringComponent2 = Class(TComponent)
+  private
+    F: String;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // WideString property
+  TWideStringComponent = Class(TComponent)
+  private
+    F: WideString;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // WideString property, empty
+  TWideStringComponent2 = Class(TComponent)
+  private
+    F: WideString;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // Single property
+  TSingleComponent = Class(TComponent)
+  private
+    F: Single;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property SingleProp : Single Read F Write F;
+  end;
+
+  // Double property
+  TDoubleComponent = Class(TComponent)
+  private
+    F: Double;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DoubleProp : Double Read F Write F;
+  end;
+
+  // Extended property
+  TExtendedComponent = Class(TComponent)
+  private
+    F: Extended;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property ExtendedProp : Extended Read F Write F;
+  end;
+
+  // Comp property
+  TCompComponent = Class(TComponent)
+  private
+    F: Comp;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CompProp : Comp Read F Write F;
+  end;
+
+  // Currency property
+  TCurrencyComponent = Class(TComponent)
+  private
+    F: Currency;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CurrencyProp : Currency Read F Write F;
+  end;
+
+  // DateTime property, date only
+  TDateTimeComponent = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, time only
+  TDateTimeComponent2 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, Date and time
+  TDateTimeComponent3 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  TDice = (one,two,three,four,five,six);
+
+  // Enum property. No default (i.e. 0)
+  TEnumComponent = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum  property, not set
+  TEnumComponent2 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum property with default, not set
+  TEnumComponent3 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, set
+  TEnumComponent4 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, no need to set
+  TEnumComponent5 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F default one;
+  end;
+
+  Throws = Set of TDice;
+
+  // Set property, no default.
+  TSetComponent = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, no default, not set
+  TSetComponent2 = Class(TComponent)
+  private
+    F: Throws;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, default, not set
+  TSetComponent3 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Set property, default, set
+  TSetComponent4 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Multiple components.
+  TMultipleComponent = Class(TComponent)
+  private
+    FCurrency: Currency;
+    FInt: Integer;
+    FString: String;
+    FDice: TDice;
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property IntProp : Integer Read FInt Write FInt;
+    Property StringProp : String Read FString Write FString;
+    Property CurrencyProp : Currency Read FCurrency Write FCurrency;
+    Property Dice : TDice Read FDice Write FDice;
+    Property Throw : Throws Read F Write F;
+  end;
+
+  TTestPersistent1 = Class(TPersistent)
+  private
+    FInt: Integer;
+    FAstring: String;
+  Public
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property AInteger : Integer Read FInt Write FInt;
+    Property AString : String Read FAstring Write FAsTring;
+  end;
+
+  // Persistent as a published property.
+  TPersistentComponent = Class(TComponent)
+  private
+    FPers: TTestPersistent1;
+    procedure SetPers(const Value: TTestPersistent1);
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+    Destructor Destroy; override;
+  Published
+    Property Persist : TTestPersistent1 Read FPers Write SetPers;
+  end;
+
+  // For use in collection streaming
+  TTestItem = Class(TCollectionItem)
+  Private
+    F : String;
+  Published
+    Property StrProp : String Read F Write F;
+  end;
+
+  // For use in collection streaming: items with two properties
+
+  { TTest2Item }
+
+  TTest2Item = Class(TCollectionItem)
+  Private
+    F1, F2 : String;
+  public
+  Published
+    Property StrProp1 : String Read F1 Write F1;
+    Property StrProp2 : String Read F2 Write F2;
+  end;
+
+
+  TTestCollection = Class(TCollection)
+  Public
+    Constructor Create;
+  end;
+
+  // Empty collection
+  TCollectionComponent = Class(TComponent)
+  Private
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetCOll;
+  end;
+
+  // collection with elements.
+  TCollectionComponent2 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with elements, one has no props
+  TCollectionComponent3 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with changed propname, one element
+  TCollectionComponent4 = Class(TComponent)
+    FColl : TTestCollection;
+    Procedure SetColl(AColl : TTestCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TTestCollection Read FColl Write SetColl;
+  end;
+
+  // collection two elements, items with two properties
+  TCollectionComponent5 = Class(TComponent)
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetColl;
+  end;
+
+  // Component as published property
+  TOwnedComponent = Class(TComponent)
+    F : TComponent;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CompProp : TComponent Read F Write F;
+  end;
+
+  // Use this if owned components should also be streamed.
+  TChildrenComponent = Class(TComponent)
+    // Owned components are children
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+  end;
+
+  // Stream sub component.
+  TStreamedOwnedComponent = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Sub : TIntegerComponent;
+  end;
+  
+  // Stream 2 sub components
+  TStreamedOwnedComponents = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    SubA : TIntegerComponent;
+    SubB : TStringComponent;
+  end;
+
+  // Method tests.
+
+  THandler = Procedure of Object;
+
+  // Method property that points to own method.
+  TMethodComponent = Class(TComponent)
+  Private
+    F : THandler;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod;
+    Property MethodProp : THandler Read F Write F;
+  end;
+
+  // Method property of owned component that points to own method.
+  TMethodComponent2 = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod2;
+  end;
+
+  { TVariantComponent }
+
+  TVariantComponent = Class(TComponent)
+  private
+    FVariant: Variant;
+  Published
+    Property VariantProp : Variant Read FVariant Write FVariant;
+  end;
+
+  TBooleanComponent = Class(TComponent)
+  private
+    FBoolean: Boolean;
+  Published
+    Property BooleanProp : Boolean Read FBoolean Write FBoolean;
+  end;
+
+  TemptyPersistent = Class(TPersistent);
+
+  { TStringsCOmponent }
+
+  TStringsCOmponent = Class(TComponent)
+  private
+    FStrings: TStrings;
+    procedure SetStrings(AValue: TStrings);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property StringsProp : TStrings Read FStrings Write SetStrings;
+  end;
+Implementation
+
+{ TStringsCOmponent }
+
+procedure TStringsCOmponent.SetStrings(AValue: TStrings);
+begin
+  if FStrings=AValue then Exit;
+  FStrings.Assign(AValue);
+end;
+
+constructor TStringsCOmponent.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FStrings:=TStringList.Create;
+  FStrings.Add('One');
+  FStrings.Add('Two');
+  FStrings.Add('Three');
+end;
+
+destructor TStringsCOmponent.Destroy;
+begin
+  FreeAndNil(FStrings);
+  inherited Destroy;
+end;
+
+procedure TChildrenComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to ComponentCount-1 do
+    Proc(Components[i]);
+end;
+
+
+{ TIntegerComponent }
+
+constructor TIntegerComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=3;
+end;
+
+
+{ TInt64Component }
+
+constructor TInt64Component.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=4;
+end;
+
+{ TInt64Component2 }
+
+constructor TInt64Component2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=2 shl 9;
+end;
+
+{ TIntegerComponent2 }
+
+constructor TIntegerComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 9;
+end;
+
+{ TIntegerComponent3 }
+
+constructor TIntegerComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component3 }
+
+constructor TInt64Component3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component4 }
+
+constructor TInt64Component4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=Int64(MaxInt)+Int64(2 shl 17);
+end;
+
+{ TStringComponent }
+
+constructor TStringComponent.Create(AOwner: TComponent);
+begin
+  Inherited;
+  F:='A string';
+end;
+
+{ TWideStringComponent }
+
+constructor TWideStringComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:='Some WideString';
+end;
+
+{ TSingleComponent }
+
+constructor TSingleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=1.23;
+end;
+
+{ TDoubleComponent }
+
+constructor TDoubleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=2.34;
+end;
+
+{ TExtendedComponent }
+
+constructor TExtendedComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=3.45;
+end;
+
+{ TCompComponent }
+
+constructor TCompComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=4.56;
+end;
+
+{ TCurrencyComponent }
+
+constructor TCurrencyComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=5.67;
+end;
+
+{ TDateTimeComponent }
+
+constructor TDateTimeComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1);
+end;
+
+{ TDateTimeComponent2 }
+
+constructor TDateTimeComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeTime(23,20,0,0);
+end;
+
+{ TDateTimeComponent3 }
+
+constructor TDateTimeComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0);
+end;
+
+{ TEnumComponent }
+
+constructor TEnumComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Four;
+end;
+
+{ TSetComponent }
+
+constructor TSetComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[two,five];
+end;
+
+{ TIntegerComponent4 }
+
+constructor TIntegerComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=6;
+end;
+
+{ TIntegerComponent5 }
+
+constructor TIntegerComponent5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=5;
+end;
+
+{ TInt64Component5 }
+
+constructor TInt64Component5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=7;
+end;
+
+{ TInt64Component6 }
+
+constructor TInt64Component6.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=8;
+end;
+
+{ TEnumComponent3 }
+
+constructor TEnumComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Three;
+end;
+
+{ TEnumComponent4 }
+
+constructor TEnumComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Two;
+end;
+
+{ TSetComponent4 }
+
+constructor TSetComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[Three,Six];
+end;
+
+{ TSetComponent3 }
+
+constructor TSetComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[One,Four];
+end;
+
+{ TMultipleComponent }
+
+constructor TMultipleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FInt:=1;
+  FCurrency:=2.3;
+  FString:='A String';
+  FDice:=two;
+  F:=[three,four];
+end;
+
+{ TTestPersistent1 }
+
+procedure TTestPersistent1.Assign(ASource: TPersistent);
+
+Var
+  T :TTestPersistent1;
+
+begin
+  If ASource is TTestPersistent1 then
+    begin
+    T:=ASource as TTestPersistent1;
+    FInt:=T.FInt;
+    FAString:=T.FAString;
+    end
+  else
+    inherited;
+end;
+
+{ TPersistentComponent }
+
+constructor TPersistentComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FPers:=TTestPersistent1.Create;
+  FPers.AInteger:=3;
+  FPers.AString:='A persistent string';
+end;
+
+Destructor TPersistentComponent.Destroy;
+
+begin
+  FreeAndNil(FPers);
+  Inherited;
+end;
+
+procedure TPersistentComponent.SetPers(const Value: TTestPersistent1);
+begin
+  FPers.Assign(Value);
+end;
+
+{ TCollectionComponent }
+
+Procedure TCollectionComponent.SetColl(AColl : TCollection);
+
+begin
+  FColl.Assign(AColl);
+end;
+
+Constructor TCollectionComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  FColl:=TCollection.Create(TTestItem);
+end;
+
+Destructor TCollectionComponent.Destroy;
+
+begin
+  FreeAndNil(FColl);
+  Inherited;
+end;
+
+{ TCollectionComponent2 }
+
+Constructor TCollectionComponent2.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='Second';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponen3 }
+
+Constructor TCollectionComponent3.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponent4 }
+
+constructor TCollectionComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FColl:=TTestCollection.Create;
+  (FColl.Add as TTestItem).StrProp:='Something'
+end;
+
+destructor TCollectionComponent4.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited;
+end;
+
+procedure TCollectionComponent4.SetColl(AColl: TTestCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+{ TCollectionComponent5 }
+
+procedure TCollectionComponent5.SetColl(AColl: TCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+constructor TCollectionComponent5.Create(AOwner: TComponent);
+var
+  Item : TTest2Item;
+begin
+  inherited Create(AOwner);
+  FColl:=TCollection.Create(TTest2Item);
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something';
+  Item.StrProp2 := 'Otherthing';
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something 2';
+  Item.StrProp2 := 'Otherthing 2';
+end;
+
+destructor TCollectionComponent5.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited Destroy;
+end;
+
+{ TTestCollection }
+
+Constructor TTestCollection.Create;
+begin
+  Inherited Create(TTestitem);
+  PropName:='MyCollProp';
+end;
+
+{ TStreamedOwnedComponent }
+
+Constructor TStreamedOwnedComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  Sub:=TIntegerComponent.Create(Self);
+  Sub.Name:='Sub';
+end;
+
+{ TStreamedOwnedComponents }
+
+constructor TStreamedOwnedComponents.Create(AOwner: TComponent);
+begin
+  inherited;
+  SubA:=TIntegerComponent.Create(Self);
+  SubA.Name:='SubA';
+  SubB:=TStringComponent.Create(Self);
+  SubB.Name:='SubB';
+end;
+
+
+Constructor TOwnedComponent.Create(AOwner : TComponent);
+
+Var
+  C: TComponent;
+
+begin
+  Inherited;
+  C:=TIntegerComponent.Create(Self);
+  C.Name:='SubComponent';
+  CompProp:=C;
+end;
+
+
+{ TMethodComponent }
+
+Constructor TMethodComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+{$ifdef fpc}
+  MethodProp:=@MyMethod;
+{$else}
+  MethodProp:=MyMethod;
+{$endif}
+end;
+
+Procedure TMethodComponent.MyMethod;
+
+begin
+  // Do nothing.
+end;
+
+{ TMethodComponent2 }
+
+constructor TMethodComponent2.Create(AOwner: TComponent);
+
+Var
+  C : TMethodComponent;
+
+begin
+  inherited;
+  C:=TMethodComponent.Create(Self);
+  C.Name:='AComponent';
+{$ifdef fpc}
+  C.MethodProp:=@MyMethod2;
+{$else}
+  C.MethodProp:=MyMethod2;
+{$endif}
+end;
+
+Procedure TMethodComponent2.MyMethod2;
+
+begin
+ // Do nothng
+end;
+
+
+end.

+ 93 - 0
compiler/packages/fcl-json/tests/testjson.lpi

@@ -0,0 +1,93 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <CommandLineParams Value="--suite=TTestJSONString.TestJSONStringToString"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=TTestJSONString.TestJSONStringToString"/>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="6">
+      <Unit0>
+        <Filename Value="testjson.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="testjsonparser.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="testjsondata.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="testjsonrtti.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../src/fpjsonrtti.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="testjsonreader.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="../src"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="EConvertError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EJSON"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 41 - 0
compiler/packages/fcl-json/tests/testjson.pp

@@ -0,0 +1,41 @@
+{
+    This file is part of the Free Component Library
+
+    JSON fpcunit tester program
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+program testjson;
+
+uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
+  Classes, testjsondata, testjsonparser, testjsonrtti, consoletestrunner, testjsonreader;
+
+type
+  { TLazTestRunner }
+   TMyTestRunner = class(TTestRunner)
+   protected
+     // override the protected methods of TTestRunner to customize its behavior
+   end;
+      
+var
+  Application: TMyTestRunner;
+begin
+  DefaultFormat := fPlain;
+  DefaultRunAllTests := True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;  
+  Application.Free;
+end.

+ 70 - 0
compiler/packages/fcl-json/tests/testjson2code.lpi

@@ -0,0 +1,70 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testjson2code"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--suite=TestLoadObjectProperty"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testjson2code.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcjsontocode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../src/fpjsontopas.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 52 - 0
compiler/packages/fcl-json/tests/testjson2code.lpr

@@ -0,0 +1,52 @@
+program testjson2code;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tcjsontocode, fpjsontopas;
+
+type
+
+  { TLazTestRunner }
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+    function GetShortOpts: string; override;
+    procedure AppendLongOpts; override;
+    procedure DoRun; override;
+  end;
+
+var
+  Application: TMyTestRunner;
+
+{ TMyTestRunner }
+
+function TMyTestRunner.GetShortOpts: string;
+begin
+  Result:=inherited GetShortOpts;
+  Result:=Result+'t:';
+end;
+
+procedure TMyTestRunner.AppendLongOpts;
+begin
+  inherited AppendLongOpts;
+  LongOpts.Add('testunitdir:');
+end;
+
+procedure TMyTestRunner.DoRun;
+begin
+  TestUnitDir:=GetOptionValue('t','testunitdir');
+  inherited DoRun;
+end;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

+ 66 - 0
compiler/packages/fcl-json/tests/testjsonconf.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testjsonconf.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="jsonconftest.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../src/jsonconf.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="jsonConf"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="../src"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+  </CompilerOptions>
+</CONFIG>

+ 28 - 0
compiler/packages/fcl-json/tests/testjsonconf.pp

@@ -0,0 +1,28 @@
+program testjsonconf;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$ifdef unix}cwstring,{$endif}
+  Classes, consoletestrunner, jsonconftest, jsonconf;
+
+type
+
+  { TLazTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

+ 4098 - 0
compiler/packages/fcl-json/tests/testjsondata.pp

@@ -0,0 +1,4098 @@
+{
+    This file is part of the Free Component Library
+
+    JSON FPCUNit test for data structures
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit testjsondata; 
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, contnrs;
+
+type
+   TMyNull     = Class(TJSONNull);
+   TMyInteger  = Class(TJSONIntegerNumber);
+   TMyInt64    = Class(TJSONInt64Number);
+   TMyQWord    = Class(TJSONQWordNumber);
+   TMyFloat    = Class(TJSONFloatNumber);
+   TMyString   = Class(TJSONString);
+   TMyBoolean  = Class(TJSONBoolean);
+   TMyArray    = Class(TJSONArray);
+   TMyObject   = Class(TJSONObject);
+
+  { TTestJSONString }
+
+  TTestJSONString = Class(TTestCase)
+  Private
+    Procedure TestTo(Const Src,Dest : String; Strict : Boolean = False);
+    Procedure TestFrom(Const Src,Dest : String);
+  Published
+    Procedure TestJSONStringToString;
+    Procedure TestStringToJSONString;
+  end;
+  
+  { TTestJSON }
+  
+  TTestJSON = Class(TTestCase)
+  private
+  Protected
+    procedure SetDefaultInstanceTypes;
+    procedure SetMyInstanceTypes;
+    Procedure SetUp; override;
+    Procedure TestItemCount(J : TJSONData;Expected : Integer);
+    Procedure TestJSONType(J : TJSONData;Expected : TJSONType);
+    Procedure TestJSON(J : TJSONData;Expected : String);
+    Procedure TestIsNull(J : TJSONData;Expected : Boolean);
+    Procedure TestAsBoolean(J : TJSONData;Expected : Boolean; ExpectError : boolean = False);
+    Procedure TestAsInteger(J : TJSONData; Expected : Integer; ExpectError : boolean = False);
+    Procedure TestAsInt64(J : TJSONData; Expected : Int64; ExpectError : boolean = False);
+    Procedure TestAsQWord(J : TJSONData; Expected : QWord; ExpectError : boolean = False);
+    Procedure TestAsString(J : TJSONData; Expected : String; ExpectError : boolean = False);
+    Procedure TestAsFloat(J : TJSONData; Expected : TJSONFloat; ExpectError : boolean = False);
+  end;
+  
+  { TTestNull }
+
+  TTestNull = class(TTestJSON)
+  published
+    procedure TestNull;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+  
+  { TTestBoolean }
+
+  TTestBoolean = class(TTestJSON)
+  published
+    procedure TestTrue;
+    procedure TestFalse;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+  
+  { TTestInteger }
+
+  TTestInteger = class(TTestJSON)
+  Private
+    Procedure DoTest(I : Integer);
+  published
+    procedure TestPositive;
+    procedure TestNegative;
+    procedure TestZero;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+
+  { TTestInt64 }
+
+  TTestInt64 = class(TTestJSON)
+  Private
+    Procedure DoTest(I : Int64);
+  published
+    procedure TestPositive;
+    procedure TestNegative;
+    procedure TestZero;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+
+  { TTestQword }
+
+  TTestQword = class(TTestJSON)
+  Private
+    Procedure DoTest(Q : QWord);
+  published
+    procedure TestPositive;
+    procedure TestZero;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+
+  { TTestFloat }
+
+  TTestFloat = class(TTestJSON)
+  Private
+    Procedure DoTest(F : TJSONFloat);
+  published
+    procedure TestPositive;
+    procedure TestNegative;
+    procedure TestZero;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+
+  { TTestString }
+
+  TTestString = class(TTestJSON)
+  private
+    procedure DoTestFloat(F: TJSOnFloat; S: String; OK: Boolean);
+  published
+    procedure TestString;
+    procedure TestControlString;
+    procedure TestSolidus;
+    procedure TestInteger;
+    procedure TestNegativeInteger;
+    procedure TestFloat;
+    procedure TestNegativeFloat;
+    Procedure TestBooleanTrue;
+    Procedure TestBooleanFalse;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+  end;
+  
+  { TTestArray }
+
+  TTestArray = class(TTestJSON)
+  private
+    procedure TestAddBoolean(B : Boolean);
+    procedure TestInsertBoolean(B : Boolean);
+  published
+    Procedure TestCreate;
+    Procedure TestCreateString;
+    Procedure TestCreatePchar;
+    procedure TestCreateStrings;
+    procedure TestCreateStringsCompressed;
+    procedure TestCreateInteger;
+    procedure TestCreateInt64;
+    procedure TestCreateFloat;
+    procedure TestCreateBoolean;
+    procedure TestCreateObject;
+    procedure TestCreateJSONString;
+    procedure TestCreateJSONObject;
+    procedure TestCreateNilPointer;
+    procedure TestCreatePointer;
+    procedure TestAddInteger;
+    procedure TestAddInt64;
+    procedure TestAddFloat;
+    procedure TestAddBooleanTrue;
+    procedure TestAddBooleanFalse;
+    procedure TestAddString;
+    procedure TestAddNull;
+    procedure TestAddObject;
+    procedure TestAddArray;
+    procedure TestInsertInteger;
+    procedure TestInsertInt64;
+    procedure TestInsertFloat;
+    procedure TestInsertBooleanTrue;
+    procedure TestInsertBooleanFalse;
+    procedure TestInsertString;
+    procedure TestInsertNull;
+    procedure TestInsertObject;
+    procedure TestInsertArray;
+    procedure TestMove;
+    procedure TestExchange;
+    procedure TestDelete;
+    procedure TestRemove;
+    Procedure TestClone;
+    Procedure TestMyClone;
+    Procedure TestFormat;
+    Procedure TestFormatNil;
+  end;
+  
+  { TTestObject }
+
+  TTestObject = class(TTestJSON)
+  private
+    FJ: TJSONObject;
+    procedure AppendA;
+  protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    procedure TestAddBoolean(B : Boolean);
+    Procedure TestAccessError;
+    Property J : TJSONObject Read FJ;
+  published
+    Procedure TestCreate;
+    Procedure TestCreateString;
+    Procedure TestCreateStringUnquoted;
+    Procedure TestCreatePchar;
+    Procedure TestCreatePcharUnquoted;
+    procedure TestCreateStrings;
+    procedure TestCreateStringsCompressed;
+    procedure TestCreateStringsCompressedUnquoted;
+    procedure TestCreateInteger;
+    procedure TestCreateIntegerUnquoted;
+    procedure TestCreateInt64;
+    procedure TestCreateInt64Unquoted;
+    procedure TestCreateFloat;
+    procedure TestCreateFloatUnquoted;
+    procedure TestCreateBoolean;
+    procedure TestCreateBooleanUnquoted;
+    procedure TestCreateObject;
+    procedure TestCreateJSONString;
+    procedure TestCreateJSONStringUnquoted;
+    procedure TestCreateJSONObject;
+    procedure TestCreateJSONObjectUnquoted;
+    procedure TestCreateNilPointer;
+    procedure TestCreatePointer;
+    procedure TestAddInteger;
+    procedure TestAddInt64;
+    procedure TestAddFloat;
+    procedure TestAddBooleanTrue;
+    procedure TestAddBooleanFalse;
+    procedure TestAddString;
+    procedure TestAddNull;
+    procedure TestAddObject;
+    procedure TestAddArray;
+    procedure TestDelete;
+    procedure TestRemove;
+    procedure TestClone;
+    procedure TestMyClone;
+    procedure TestExtract;
+    Procedure TestNonExistingAccessError;
+    Procedure TestFormat;
+    Procedure TestFormatNil;
+    Procedure TestFind;
+    Procedure TestIfFind;
+    Procedure TestDuplicate;
+  end;
+
+  { TTestJSONPath }
+
+  TTestJSONPath = class(TTestJSON)
+  private
+    FData: TJSONData;
+  Protected
+    Procedure TearDown; override;
+    Property Data : TJSONData read FData Write FData;
+  Published
+    Procedure TestNullEmpty;
+    Procedure TestNullGet;
+    Procedure TestNullNonExisting;
+    Procedure TestNullNotEmpty;
+    Procedure TestBooleanEmpty;
+    Procedure TestBooleanNotEmpty;
+    Procedure TestIntegerEmpty;
+    Procedure TestIntegerNotEmpty;
+    Procedure TestInt64Empty;
+    Procedure TestInt64NotEmpty;
+    Procedure TestFloatEmpty;
+    Procedure TestFloatNotEmpty;
+    Procedure TestStringEmpty;
+    Procedure TestStringNotEmpty;
+    Procedure TestArrayEmpty;
+    Procedure TestArrayNotIndex;
+    Procedure TestArrayIncompleteIndex;
+    Procedure TestArrayNonNumericalIndex;
+    Procedure TestArrayOutOfRangeIndex;
+    Procedure TestArrayCorrectIndex;
+    Procedure TestArrayRecursiveArray;
+    Procedure TestArrayRecursiveObject;
+    Procedure TestObjectEmpty;
+    Procedure TestObjectDots;
+    Procedure TestObjectExisting;
+    Procedure TestObjectNonExisting;
+    Procedure TestObjectTrailingDot;
+    Procedure TestObjectRecursiveArray;
+    Procedure TestObjectRecursiveObject;
+    Procedure TestDeepRecursive;
+  end;
+
+  { TTestFactory }
+
+  TTestFactory = class(TTestJSON)
+  Private
+    FType : TJSONInstanceType;
+    FClass : TJSONDataClass;
+    FData: TJSONData;
+  Protected
+    Procedure DoSet;
+    Procedure TearDown; override;
+    Procedure AssertElement0(AClass : TJSONDataClass);
+    Procedure AssertElementA(AClass : TJSONDataClass);
+    Property Data : TJSONData read FData Write FData;
+  Published
+    Procedure TestSet;
+    Procedure TestSetInvalid;
+    Procedure CreateNull;
+    Procedure CreateInteger;
+    Procedure CreateInt64;
+    Procedure CreateFloat;
+    Procedure CreateBoolean;
+    Procedure CreateString;
+    Procedure CreateArray;
+    Procedure CreateObject;
+    Procedure ArrayAddNull;
+    Procedure ArrayAddInteger;
+    Procedure ArrayAddInt64;
+    Procedure ArrayAddFloat;
+    Procedure ArrayAddBoolean;
+    Procedure ArrayAddString;
+    Procedure ArrayCreateNull;
+    Procedure ArrayCreateInteger;
+    Procedure ArrayCreateInt64;
+    Procedure ArrayCreateFloat;
+    Procedure ArrayCreateBoolean;
+    Procedure ArrayCreateString;
+    Procedure ObjectAddNull;
+    Procedure ObjectAddInteger;
+    Procedure ObjectAddInt64;
+    Procedure ObjectAddFloat;
+    Procedure ObjectAddBoolean;
+    Procedure ObjectAddString;
+    Procedure ObjectCreateNull;
+    Procedure ObjectCreateInteger;
+    Procedure ObjectCreateInt64;
+    Procedure ObjectCreateFloat;
+    Procedure ObjectCreateBoolean;
+    Procedure ObjectCreateString;
+  end;
+
+  { TTestIterator }
+
+  TTestIterator = class(TTestJSON)
+  private
+    FData: TJSONData;
+  Protected
+    Procedure TearDown; override;
+    Procedure TestSingle;
+    Procedure TestLoop(ACount : Integer);
+    Property Data : TJSONData Read FData Write FData;
+  Published
+    Procedure TestNull;
+    Procedure TestInteger;
+    Procedure TestInt64;
+    Procedure TestFloat;
+    Procedure TestBoolean;
+    Procedure TestString;
+    Procedure TestArray;
+    Procedure TestObject;
+  end;
+
+
+implementation
+
+{ TTestIterator }
+
+procedure TTestIterator.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestIterator.TestSingle;
+
+Var
+  F : TJSONEnum;
+  C : Integer;
+
+begin
+  C:=0;
+  For F in Data do
+   begin
+   Inc(C);
+   If C>1 then
+     Fail(Data.ClassName+' loops more than once');
+   AssertEquals(Data.ClassName+' has empty key','',F.Key);
+   AssertEquals(Data.ClassName+' has empty numerical key',0,F.KeyNum);
+   AssertSame(Data.ClassName+' returns data',Data,F.Value);
+   end;
+  If C<1 then
+    Fail(Data.ClassName+' Loops not even once');
+end;
+
+procedure TTestIterator.TestLoop(ACount: Integer);
+Var
+  F : TJSONEnum;
+  C : Integer;
+
+begin
+  C:=0;
+  For F in Data do
+   begin
+   AssertEquals(Data.ClassName+' has correct string key',IntToStr(C),F.Key);
+   AssertEquals(Data.ClassName+' has correct numerical key',C,F.KeyNum);
+   AssertSame(Data.ClassName+' returns correct data',Data.Items[C],F.Value);
+   Inc(C);
+   end;
+  AssertEquals(Data.ClassName+' correct loop count',ACount,C);
+end;
+
+procedure TTestIterator.TestNull;
+begin
+  Data:=TJSONNull.Create;
+  TestSingle;
+end;
+
+procedure TTestIterator.TestInteger;
+begin
+  Data:=TJSONIntegerNumber.Create(1);
+  TestSingle;
+end;
+
+procedure TTestIterator.TestInt64;
+begin
+  Data:=TJSONInt64Number.Create(1);
+  TestSingle;
+end;
+
+procedure TTestIterator.TestFloat;
+begin
+  Data:=TJSONFloatNumber.Create(1.2);
+  TestSingle;
+end;
+
+procedure TTestIterator.TestBoolean;
+begin
+  Data:=TJSONBoolean.Create(True);
+  TestSingle;
+end;
+
+procedure TTestIterator.TestString;
+begin
+  Data:=TJSONString.Create('Data');
+  TestSingle;
+end;
+
+procedure TTestIterator.TestArray;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  TestLoop(3);
+end;
+
+procedure TTestIterator.TestObject;
+begin
+  Data:=TJSONObject.Create(['0',1,'1',2,'2',3]);
+  TestLoop(3);
+end;
+
+{ TTestFactory }
+
+procedure TTestFactory.DoSet;
+begin
+  SetJSONInstanceType(FType,FClass);
+end;
+
+procedure TTestFactory.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestFactory.AssertElement0(AClass: TJSONDataClass);
+begin
+  AssertEquals('Correct class',TMyArray,Data.ClassType);
+  AssertEquals('Have 1 element',1,Data.Count);
+  AssertEquals('Correct class',AClass,(Data as TJSONArray)[0].ClassType);
+end;
+
+procedure TTestFactory.AssertElementA(AClass: TJSONDataClass);
+begin
+  AssertEquals('Correct class',TMyObject,Data.ClassType);
+  AssertEquals('Have element a',0,TMyObject(Data).IndexOfName('a'));
+  AssertEquals('Correct class',AClass,(Data as TJSONObject).Elements['a'].ClassType);
+end;
+
+procedure TTestFactory.TestSet;
+begin
+  SetMyInstanceTypes;
+  AssertEquals('Correct type for unknown',TJSONData,GetJSONInstanceType(jitUnknown));
+  AssertEquals('Correct type for integer',TMyInteger,GetJSONInstanceType(jitNumberInteger));
+  AssertEquals('Correct type for int64',TMyInt64,GetJSONInstanceType(jitNumberInt64));
+  AssertEquals('Correct type for float',TMyFloat,GetJSONInstanceType(jitNumberFloat));
+  AssertEquals('Correct type for boolean',TMyBoolean,GetJSONInstanceType(jitBoolean));
+  AssertEquals('Correct type for null',TMyNull,GetJSONInstanceType(jitNUll));
+  AssertEquals('Correct type for String',TMyString,GetJSONInstanceType(jitString));
+  AssertEquals('Correct type for Array',TMyArray,GetJSONInstanceType(jitArray));
+  AssertEquals('Correct type for Object',TMyObject,GetJSONInstanceType(jitObject));
+end;
+
+procedure TTestFactory.TestSetInvalid;
+
+Const
+  MyJSONInstanceTypes :
+    Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
+    TMyInt64,TMyQWord,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
+    TMyObject);
+
+Var
+  Ti : TJSONInstanceType;
+
+begin
+  For ti:=Succ(Low(TJSONInstanceType)) to High(TJSONInstanceType) do
+    begin
+    FType:=Ti;
+    FClass:=MyJSONInstanceTypes[Pred(ti)];
+    AssertException('Set '+FClass.ClassName,EJSON,@DoSet);
+    end;
+  FType:=jitString;
+  FClass:=Nil;
+  AssertException('Set Nil',EJSON,@DoSet);
+end;
+
+procedure TTestFactory.CreateNull;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON;
+  AssertEquals('Correct class',TMyNull,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateInteger;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON(1);
+  AssertEquals('Correct class',TMyInteger,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateInt64;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON(Int64(1));
+  AssertEquals('Correct class',TMyInt64,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateFloat;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON(1.2);
+  AssertEquals('Correct class',TMyFloat,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateBoolean;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON(True);
+  AssertEquals('Correct class',TMyBoolean,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateString;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSON('True');
+  AssertEquals('Correct class',TMyString,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateArray;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray(['True']);
+  AssertEquals('Correct class',TMyArray,Data.ClassType);
+end;
+
+procedure TTestFactory.CreateObject;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a','True']);
+  AssertEquals('Correct class',TMyObject,Data.ClassType);
+end;
+
+procedure TTestFactory.ArrayAddNull;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add();
+  AssertElement0(TMyNull);
+end;
+
+procedure TTestFactory.ArrayAddInteger;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add(1);
+  AssertElement0(TMyInteger);
+end;
+
+procedure TTestFactory.ArrayAddInt64;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add(Int64(1));
+  AssertElement0(TMyInt64);
+end;
+
+procedure TTestFactory.ArrayAddFloat;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add(1.2);
+  AssertElement0(TMyFloat);
+end;
+
+procedure TTestFactory.ArrayAddBoolean;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add(True);
+  AssertElement0(TMyBoolean);
+end;
+
+procedure TTestFactory.ArrayAddString;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([]);
+  TJSONArray(Data).Add('True');
+  AssertElement0(TMyString);
+end;
+
+procedure TTestFactory.ArrayCreateNull;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([Nil]);
+  AssertElement0(TMyNull);
+end;
+
+procedure TTestFactory.ArrayCreateInteger;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([1]);
+  AssertElement0(TMyInteger);
+end;
+
+procedure TTestFactory.ArrayCreateInt64;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([int64(1)]);
+  AssertElement0(TMyInt64);
+end;
+
+procedure TTestFactory.ArrayCreateFloat;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([1.2]);
+  AssertElement0(TMyFloat);
+end;
+
+procedure TTestFactory.ArrayCreateBoolean;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray([True]);
+  AssertElement0(TMyBoolean);
+end;
+
+procedure TTestFactory.ArrayCreateString;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONArray(['true']);
+  AssertElement0(TMyString);
+end;
+
+procedure TTestFactory.ObjectAddNull;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a');
+  AssertElementA(TMyNull);
+end;
+
+procedure TTestFactory.ObjectAddInteger;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a',1);
+  AssertElementA(TMyInteger);
+end;
+
+procedure TTestFactory.ObjectAddInt64;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a',Int64(1));
+  AssertElementA(TMyInt64);
+end;
+
+procedure TTestFactory.ObjectAddFloat;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a',1.2);
+  AssertElementA(TMyFloat);
+end;
+
+procedure TTestFactory.ObjectAddBoolean;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a',True);
+  AssertElementA(TMyBoolean);
+end;
+
+procedure TTestFactory.ObjectAddString;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject([]);
+  TJSONObject(Data).Add('a','True');
+  AssertElementA(TMyString);
+end;
+
+procedure TTestFactory.ObjectCreateNull;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a',Nil]);
+  AssertElementA(TMyNull);
+end;
+
+procedure TTestFactory.ObjectCreateInteger;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a',1]);
+  AssertElementA(TMyInteger);
+end;
+
+procedure TTestFactory.ObjectCreateInt64;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a',int64(1)]);
+  AssertElementA(TMyInt64);
+end;
+
+procedure TTestFactory.ObjectCreateFloat;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a',1.2]);
+  AssertElementA(TMyFloat);
+end;
+
+procedure TTestFactory.ObjectCreateBoolean;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a',True]);
+  AssertElementA(TMyBoolean);
+end;
+
+procedure TTestFactory.ObjectCreateString;
+begin
+  SetMyInstanceTypes;
+  Data:=CreateJSONObject(['a','true']);
+  AssertElementA(TMyString);
+end;
+
+{ TTestJSONPath }
+
+procedure TTestJSONPath.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestJSONPath.TestNullEmpty;
+begin
+  Data:=TJSONNull.Create;
+  AssertSame('Empty on NULL returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestNullGet;
+begin
+  Data:=TJSONNull.Create;
+  AssertSame('Empty get on NULL returns object itself',Data,Data.GetPath(''));
+end;
+
+procedure TTestJSONPath.TestNullNonExisting;
+
+Var
+  Msg : String;
+
+begin
+  Data:=TJSONNull.Create;
+  try
+    Data.GetPath('a.b.c');
+    Msg:='No exception raised'
+  except
+    on E : Exception do
+      begin
+      If Not (E is EJSON) then
+        Msg:='Wrong exception class. Got '+E.ClassName+' instead of EJSON'
+      else
+        If E.Message<>'Path "a.b.c" invalid: element "a.b.c" not found.' then
+          Msg:='Wrong exception message, expected: "Path "a.b.c" invalid: element "a.b.c" not found.", actual: "'+E.Message+'"';
+      end;
+  end;
+  If (Msg<>'') then
+    Fail(Msg);
+end;
+
+procedure TTestJSONPath.TestNullNotEmpty;
+begin
+  Data:=TJSONNull.Create;
+  AssertNull('Not empty on NULL returns nil',Data.FindPath('a'));
+end;
+
+procedure TTestJSONPath.TestBooleanEmpty;
+begin
+  Data:=TJSONBoolean.Create(true);
+  AssertSame('Empty on Boolean returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestBooleanNotEmpty;
+begin
+  Data:=TJSONBoolean.Create(True);
+  AssertNull('Not empty on Boolean returns nil',Data.FindPath('a'));
+end;
+
+procedure TTestJSONPath.TestIntegerEmpty;
+begin
+  Data:=TJSONIntegerNumber.Create(1);
+  AssertSame('Empty on integer returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestIntegerNotEmpty;
+begin
+  Data:=TJSONIntegerNumber.Create(1);
+  AssertNull('Not Empty on integer returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestInt64Empty;
+begin
+  Data:=TJSONInt64Number.Create(1);
+  AssertSame('Empty on Int64 returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestInt64NotEmpty;
+begin
+  Data:=TJSONInt64Number.Create(1);
+  AssertNull('Not Empty on Int64 returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestFloatEmpty;
+begin
+  Data:=TJSONFloatNumber.Create(1);
+  AssertSame('Empty on Float returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestFloatNotEmpty;
+begin
+  Data:=TJSONFloatNumber.Create(1);
+  AssertNull('Not Empty on Float returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestStringEmpty;
+begin
+  Data:=TJSONString.Create('1');
+  AssertSame('Empty on String returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestStringNotEmpty;
+begin
+  Data:=TJSONString.Create('1');
+  AssertNull('Not Empty on String returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestArrayEmpty;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertSame('Empty on array returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestArrayNotIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not index indication on array returns object itself',Data.FindPath('oo'));
+end;
+
+procedure TTestJSONPath.TestArrayIncompleteIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[1'));
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('['));
+end;
+
+procedure TTestJSONPath.TestArrayNonNumericalIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[a]'));
+end;
+
+procedure TTestJSONPath.TestArrayOutOfRangeIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[-1]'));
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[3]'));
+end;
+
+procedure TTestJSONPath.TestArrayCorrectIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertSame('Index 0 on array returns item 0',Data.Items[0],Data.FindPath('[0]'));
+  AssertSame('Index 1 on array returns item 1',Data.Items[1],Data.FindPath('[1]'));
+  AssertSame('Index 2 on array returns item 2',Data.Items[2],Data.FindPath('[2]'));
+end;
+
+procedure TTestJSONPath.TestArrayRecursiveArray;
+
+Var
+  A : TJSONArray;
+
+begin
+  A:=TJSONArray.Create([1,2,3]);
+  Data:=TJSONArray.Create([A,1,2,3]);
+  AssertSame('Index [0][0] on array returns item 0',A.Items[0],Data.FindPath('[0][0]'));
+  AssertSame('Index [0][1] on array returns item 1',A.Items[1],Data.FindPath('[0][1]'));
+  AssertSame('Index [0][2] on array returns item 2',A.Items[2],Data.FindPath('[0][2]'));
+end;
+
+procedure TTestJSONPath.TestArrayRecursiveObject;
+
+Var
+  A : TJSONObject;
+
+begin
+  A:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  Data:=TJSONArray.Create([A,1,2,3]);
+  AssertSame('[0]a on array returns element a of item 0',A.Elements['a'],Data.FindPath('[0]a'));
+  AssertSame('[0]b on array returns element b of item 0',A.Elements['b'],Data.FindPath('[0]b'));
+  AssertSame('[0]c on array returns element c of item 0',A.Elements['c'],Data.FindPath('[0]c'));
+  AssertSame('[0].a on array returns element a of item 0',A.Elements['a'],Data.FindPath('[0].a'));
+  AssertSame('[0].b on array returns element b of item 0',A.Elements['b'],Data.FindPath('[0].b'));
+  AssertSame('[0].c on array returns element c of item 0',A.Elements['c'],Data.FindPath('[0].c'));
+end;
+
+procedure TTestJSONPath.TestObjectEmpty;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('Empty on object returns object',Data,Data.FindPath(''));
+end;
+
+procedure TTestJSONPath.TestObjectDots;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('Dot on object returns object',Data,Data.FindPath('.'));
+  AssertSame('2 Dots on object returns object',Data,Data.FindPath('..'));
+  AssertSame('3 Dots on object returns object',Data,Data.FindPath('...'));
+end;
+
+procedure TTestJSONPath.TestObjectExisting;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('a'));
+  AssertSame('.a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('.a'));
+  AssertSame('..a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('..a'));
+end;
+
+procedure TTestJSONPath.TestObjectNonExisting;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertNull('d on object returns nil',Data.FindPath('d'));
+end;
+
+procedure TTestJSONPath.TestObjectTrailingDot;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertNull('a. on object returns nil',Data.FindPath('a.'));
+end;
+
+procedure TTestJSONPath.TestObjectRecursiveArray;
+
+Var
+  A : TJSONArray;
+
+begin
+  A:=TJSONArray.Create([1,2,3]);
+  Data:=TJSONObject.Create(['a',A,'b',2,'c',3]);
+  AssertSame('a[0] returns item 0 of array a',A.Items[0],Data.FindPath('a[0]'));
+end;
+
+procedure TTestJSONPath.TestObjectRecursiveObject;
+Var
+  O : TJSONObject;
+  D : TJSONData;
+begin
+  D :=TJSONIntegerNumber.Create(1);
+  O:=TJSONObject.Create(['b',D]);
+  Data:=TJSONObject.Create(['a',O]);
+  AssertSame('a.b returns correct data ',D,Data.FindPath('a.b'));
+  AssertSame('a..b returns correct data ',D,Data.FindPath('a..b'));
+end;
+
+procedure TTestJSONPath.TestDeepRecursive;
+Var
+  A : TJSONArray;
+  D : TJSONData;
+begin
+  D :=TJSONIntegerNumber.Create(1);
+  A:=TJSONArray.Create([0,'string',TJSONObject.Create(['b',D])]);
+  Data:=TJSONObject.Create(['a',TJSONObject.Create(['c',A])]);
+  AssertSame('a.c[2].b returns correct data ',D,Data.FindPath('a.c[2].b'));
+  AssertSame('a.c[2]b returns correct data ',D,Data.FindPath('a.c[2]b'));
+  AssertNull('a.c[2]d returns nil ',Data.FindPath('a.c[2]d'));
+end;
+
+{ TTestJSON }
+
+Const
+  DefJSONInstanceTypes :
+    Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
+    TJSONInt64Number,TJSONQWordNumber,TJSONFloatNumber, TJSONString, TJSONBoolean,
+    TJSONNull, TJSONArray, TJSONObject);
+
+Const
+  MyJSONInstanceTypes :
+    Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
+    TMyInt64, TMyQWord,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
+    TMyObject);
+
+procedure TTestJSON.SetDefaultInstanceTypes;
+
+Var
+  Ti : TJSONInstanceType;
+
+begin
+  For ti:=Low(TJSONInstanceType) to High(TJSONInstanceType) do
+   SetJSONInstanceType(Ti,DefJSONInstanceTypes[ti]);
+end;
+
+procedure TTestJSON.SetMyInstanceTypes;
+
+Var
+  Ti : TJSONInstanceType;
+
+begin
+  For ti:=Low(TJSONInstanceType) to High(TJSONInstanceType) do
+    AssertEquals('Previous value is returned by SetJSONInstanceType',DefJSONInstanceTypes[ti],SetJSONInstanceType(Ti,MyJSONInstanceTypes[ti]));
+end;
+
+Procedure TTestJSON.SetUp;
+
+
+begin
+  inherited SetUp;
+  SetDefaultInstanceTypes;
+  TJSONData.CompressedJSON:=False;
+  TJSONObject.UnquotedMemberNames:=False;
+end;
+
+Procedure TTestJSON.TestItemCount(J: TJSONData; Expected: Integer);
+begin
+  AssertEquals(J.ClassName+'.ItemCount',Expected,J.Count);
+end;
+
+Procedure TTestJSON.TestJSONType(J: TJSONData; Expected: TJSONType);
+begin
+  AssertEquals(J.ClassName+'.JSONType',Ord(Expected),Ord(J.JSONType));
+end;
+
+Procedure TTestJSON.TestJSON(J: TJSONData; Expected: String);
+begin
+  AssertEquals(J.ClassName+'.AsJSON',Expected,J.AsJSON);
+end;
+
+Procedure TTestJSON.TestIsNull(J: TJSONData; Expected: Boolean);
+begin
+  AssertEquals(J.ClassName+'.IsNull',Expected,J.IsNull);
+end;
+
+Procedure TTestJSON.TestAsBoolean(J: TJSONData; Expected: Boolean;
+  ExpectError: boolean);
+
+Var
+  B : Boolean;
+  AssignOK : Boolean;
+  Msg : String;
+  
+begin
+  AssignOK:=False;
+  Try
+    B:=J.AsBoolean;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsBoolean',Expected,B);
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsBoolean must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsBoolean raised unexpected exception: '+Msg)
+    end;
+end;
+
+Procedure TTestJSON.TestAsInteger(J: TJSONData; Expected: Integer;
+  ExpectError: boolean);
+
+Var
+  I : Integer;
+  AssignOK : Boolean;
+  Msg : String;
+
+begin
+  AssignOK:=False;
+  Try
+    I:=J.AsInteger;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsInteger',Expected,I);
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsInteger must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsInteger raised unexpected exception: '+Msg)
+    end;
+end;
+
+Procedure TTestJSON.TestAsInt64(J: TJSONData; Expected: Int64;
+  ExpectError: boolean);
+
+Var
+  I : Int64;
+  AssignOK : Boolean;
+  Msg : String;
+
+begin
+  AssignOK:=False;
+  Try
+    I:=J.AsInt64;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsInt64',Expected,I);
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsInt64 must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsInt64 raised unexpected exception: '+Msg)
+    end;
+end;
+
+Procedure TTestJSON.TestAsQWord(J: TJSONData; Expected: QWord;
+  ExpectError: boolean);
+Var
+  Q : QWord;
+  AssignOK : Boolean;
+  Msg : String;
+
+begin
+  AssignOK:=False;
+  Try
+    Q:=J.AsQWord;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsQWord',IntToStr(Expected),IntToStr(Q));
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsQWord must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsInt64 raised unexpected exception: '+Msg)
+    end;
+end;
+
+Procedure TTestJSON.TestAsString(J: TJSONData; Expected: String;
+  ExpectError: boolean);
+  
+Var
+  S : String;
+  AssignOK : Boolean;
+  Msg : String;
+
+begin
+  AssignOK:=False;
+  Try
+    S:=J.AsString;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsString',Expected,S);
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsString must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsString raised unexpected exception: '+Msg)
+    end;
+end;
+
+Procedure TTestJSON.TestAsFloat(J: TJSONData; Expected: TJSONFloat;
+  ExpectError: boolean);
+  
+Var
+  F : TJSONFloat;
+  AssignOK : Boolean;
+  Msg : String;
+
+begin
+  AssignOK:=False;
+  Try
+    F:=J.AsFloat;
+    AssignOK:=True;
+    If Not ExpectError then
+      AssertEquals(J.Classname+'.AsFloat',Expected,F);
+  except
+    On E : Exception do
+      begin
+      AssignOK:=False;
+      Msg:=E.Message;
+      end;
+  end;
+  If ExpectError then
+    begin
+    If AssignOK then
+      Fail(J.ClassName+'.AsFloat must raise error');
+    end
+  else
+    begin
+    If not AssignOK then
+      Fail(J.ClassName+'.AsFloat raised unexpected exception: '+Msg)
+    end;
+end;
+
+{ TTestBoolean }
+
+procedure TTestBoolean.TestTrue;
+
+Var
+  J : TJSONBoolean;
+
+begin
+  J:=TJSONBoolean.Create(True);
+  try
+    TestJSONType(J,jtBoolean);
+    TestItemCount(J,0);
+    TestJSON(J,'true');
+    TestIsNull(J,False);
+    TestAsBoolean(J,True);
+    TestAsInteger(J,1);
+    TestAsInt64(J,1);
+    TestAsQword(J,1);
+    TestAsString(J,BoolToStr(True,True));
+    TestAsFloat(J,1.0);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestBoolean.TestFalse;
+
+Var
+  J : TJSONBoolean;
+
+begin
+  J:=TJSONBoolean.Create(False);
+  try
+    TestJSONType(J,jtBoolean);
+    TestItemCount(J,0);
+    TestJSON(J,'false');
+    TestIsNull(J,False);
+    TestAsBoolean(J,False);
+    TestAsInteger(J,0);
+    TestAsInt64(J,0);
+    TestAsQWord(J,0);
+    TestAsString(J,BoolToStr(False,True));
+    TestAsFloat(J,0.0);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestBoolean.TestClone;
+
+Var
+  B : TJSONBoolean;
+  D : TJSONData;
+
+begin
+  B:=TJSONBoolean.Create(true);
+  try
+    D:=B.Clone;
+    try
+     TestJSONType(D,jtBoolean);
+     TestAsBoolean(D,true);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(B);
+  end;
+end;
+
+procedure TTestBoolean.TestMyClone;
+Var
+  B : TMyBoolean;
+  D : TJSONData;
+
+begin
+  B:=TMyBoolean.Create(true);
+  try
+    D:=B.Clone;
+    try
+     TestJSONType(D,jtBoolean);
+     AssertEquals('Correct class',TMyBoolean,D.ClassType);
+     TestAsBoolean(D,true);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(B);
+  end;
+end;
+
+procedure TTestBoolean.TestFormat;
+
+Var
+  B : TJSONBoolean;
+
+begin
+  B:=TJSONBoolean.Create(true);
+  try
+    AssertEquals('FormatJSON same as asJSON',B.asJSON,B.FormatJSON);
+  finally
+    B.Free;
+  end;
+end;
+
+
+
+{ TTestNull }
+
+procedure TTestNull.TestNull;
+
+Var
+  J : TJSONNull;
+
+begin
+  J:=TJSONNull.Create;
+  try
+    TestJSONType(J,jtNull);
+    TestItemCount(J,0);
+    TestJSON(J,'null');
+    TestIsNull(J,True);
+    TestAsBoolean(J,False,True);
+    TestAsInteger(J,0,true);
+    TestAsInt64(J,0,true);
+    TestAsQWord(J,0,true);
+    TestAsString(J,BoolToStr(False),true);
+    TestAsFloat(J,0.0,true);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestNull.TestClone;
+
+Var
+  J : TJSONNull;
+  D : TJSONData;
+
+begin
+  J:=TJSONNull.Create;
+  try
+    D:=J.Clone;
+    try
+      TestIsNull(D,True);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestNull.TestMyClone;
+Var
+  J : TMyNull;
+  D : TJSONData;
+
+begin
+  J:=TMyNull.Create;
+  try
+    D:=J.Clone;
+    try
+      TestIsNull(D,True);
+      AssertEquals('Correct class',TMyNull,D.ClassType);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestNull.TestFormat;
+Var
+  J : TJSONNull;
+begin
+  J:=TJSONNull.Create;
+  try
+    AssertEquals('FormatJSON same as asJSON',J.asJSON,J.FormatJSON);
+  finally
+    J.Free;
+  end;
+end;
+
+
+{ TTestString }
+
+procedure TTestString.TestString;
+
+Const
+  S = 'A string';
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,False,True);
+    TestAsInteger(J,0,true);
+    TestAsInt64(J,0,true);
+    TestAsQWord(J,0,true);
+    TestAsString(J,S);
+    TestAsFloat(J,0.0,true);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestControlString;
+Var
+  J : TJSONString;
+  I : Integer;
+  T : String;
+
+begin
+  J:=TJSONString.Create('');
+  try
+    For I:=0 to 31 do
+      begin
+      J.AsString:='-->'+Char(I)+'<--';
+      Case I of
+       8  : T:='\b';
+       9  : T:='\t';
+       10 : T:='\n';
+       12 : T:='\f';
+       13 : T:='\r';
+      else
+        T:='\u'+HexStr(I,4);
+      end;
+      AssertEquals('Control char','"-->'+T+'<--"',J.AsJSON);
+      end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestSolidus;
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create('');
+  try
+    J.AsString:='http://www.json.org/';
+    TJSONString.StrictEscaping:=True;
+    TestJSON(J,'"http:\/\/www.json.org\/"');
+    TJSONString.StrictEscaping:=False;
+    TestJSON(J,'"http://www.json.org/"');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestInteger;
+
+Const
+  S = '1';
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,True,False);
+    TestAsInteger(J,1,False);
+    TestAsInt64(J,1,False);
+    TestAsQWord(J,1,False);
+    TestAsString(J,S);
+    TestAsFloat(J,1.0,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestNegativeInteger;
+
+Const
+  S = '-1';
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,True,False);
+    TestAsInteger(J,-1,False);
+    TestAsInt64(J,-1,False);
+    TestAsQWord(J,QWord(-1),True);
+    TestAsString(J,S);
+    TestAsFloat(J,-1.0,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestFloat;
+
+begin
+  DoTestFloat(1.0,'1.0',True);
+  DoTestFloat(1.0,'1',True);
+  DoTestFloat(1.0,'1e0',True);
+  DoTestFloat(1.2,'1.2',True);
+  DoTestFloat(12.0,'1.2e1',True);
+end;
+
+procedure TTestString.TestNegativeFloat;
+begin
+  DoTestFloat(-1.0,'-1.0',True);
+  DoTestFloat(-1.0,'-1',True);
+  DoTestFloat(-1.0,'-1e0',True);
+  DoTestFloat(-1.2,'-1.2',True);
+  DoTestFloat(-12.0,'-1.2e1',True);
+end;
+
+procedure TTestString.TestBooleanTrue;
+
+Const
+  S = 'true';
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,True,False);
+    TestAsInteger(J,-1,True);
+    TestAsInt64(J,-1,True);
+    TestAsQWord(J,QWord(-1),True);
+    TestAsString(J,S);
+    TestAsFloat(J,-1.0,True);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestBooleanFalse;
+
+Const
+  S = 'false';
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,False,False);
+    TestAsInteger(J,0,True);
+    TestAsInt64(J,0,True);
+    TestAsQWord(J,0,True);
+    TestAsString(J,S);
+    TestAsFloat(J,0,True);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestString.TestClone;
+
+Var
+  S : TJSONString;
+  D : TJSONData;
+
+begin
+  S:=TJSONString.Create('aloha');
+  try
+    D:=S.Clone;
+    try
+     TestJSONType(D,jtString);
+     TestAsString(D,'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
+procedure TTestString.TestMyClone;
+Var
+  S : TMyString;
+  D : TJSONData;
+
+begin
+  S:=TMyString.Create('aloha');
+  try
+    D:=S.Clone;
+    try
+      AssertEquals('Correct class',TMyString,D.ClassType);
+     TestJSONType(D,jtString);
+     TestAsString(D,'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
+procedure TTestString.TestFormat;
+Var
+  S : TJSONString;
+
+begin
+  S:=TJSONString.Create('aloha');
+  try
+    AssertEquals('FormatJSON equals JSON',S.AsJSON,S.FormatJSOn);
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
+procedure TTestString.DoTestFloat(F : TJSOnFloat;S : String; OK : Boolean);
+
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create(S);
+  try
+    TestJSONType(J,jtString);
+    TestItemCount(J,0);
+    TestJSON(J,'"'+S+'"');
+    TestIsNull(J,False);
+    TestAsBoolean(J,(F<>0),Not OK);
+    TestAsInteger(J,Round(F),(Pos('.',S)<>0) or (Pos('E',UpperCase(S))<>0));
+    TestAsInt64(J,Round(F),(Pos('.',S)<>0) or (Pos('E',UpperCase(S))<>0));
+    if F>0 then
+      TestAsQword(J,Round(F),(Pos('.',S)<>0) or (Pos('E',UpperCase(S))<>0));
+    TestAsString(J,S);
+    TestAsFloat(J,F,Not OK);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+
+{ TTestInteger }
+
+procedure TTestInteger.DoTest(I: Integer);
+
+Var
+  J : TJSONIntegerNumber;
+
+begin
+  J:=TJSONIntegerNumber.Create(I);
+  try
+    TestJSONType(J,jtNumber);
+    TestItemCount(J,0);
+    AssertEquals('Numbertype is ntInteger',ord(ntInteger),Ord(J.NumberType));
+    TestJSON(J,IntToStr(i));
+    TestIsNull(J,False);
+    TestAsBoolean(J,(I<>0));
+    TestAsInteger(J,I);
+    TestAsInt64(J,I);
+    TestAsQword(J,I);
+    TestAsString(J,IntToStr(I));
+    TestAsFloat(J,I);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestInteger.TestPositive;
+
+begin
+  DoTest(1);
+end;
+
+procedure TTestInteger.TestNegative;
+begin
+  DoTest(-1);
+end;
+
+procedure TTestInteger.TestZero;
+begin
+  DoTest(0);
+end;
+
+procedure TTestInteger.TestClone;
+
+Var
+  I : TJSONIntegerNumber;
+  D : TJSONData;
+
+begin
+  I:=TJSONIntegerNumber.Create(99);
+  try
+    D:=I.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+
+end;
+
+procedure TTestInteger.TestMyClone;
+Var
+  I : TMyInteger;
+  D : TJSONData;
+
+begin
+  I:=TMyInteger.Create(99);
+  try
+    D:=I.Clone;
+    try
+     AssertEquals('Correct class',TMyInteger,D.ClassType);
+     TestJSONType(D,jtNumber);
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+procedure TTestInteger.TestFormat;
+
+Var
+  I : TJSONIntegerNumber;
+
+begin
+  I:=TJSONIntegerNumber.Create(99);
+  try
+    AssertEquals('FormatJSON equal to JSON',I.AsJSON,I.FormatJSON);
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+{ TTestInt64 }
+
+procedure TTestInt64.DoTest(I: Int64);
+
+Var
+  J : TJSONInt64Number;
+
+begin
+  J:=TJSONInt64Number.Create(I);
+  try
+    TestJSONType(J,jtNumber);
+    TestItemCount(J,0);
+    AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(J.NumberType));
+    TestJSON(J,IntToStr(i));
+    TestIsNull(J,False);
+    TestAsBoolean(J,(I<>0));
+    TestAsInteger(J,I);
+    TestAsInt64(J,I);
+    TestAsQword(J,I);
+    TestAsString(J,IntToStr(I));
+    TestAsFloat(J,I);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestInt64.TestPositive;
+
+begin
+  DoTest(1);
+end;
+
+procedure TTestInt64.TestNegative;
+begin
+  DoTest(-1);
+end;
+
+procedure TTestInt64.TestZero;
+begin
+  DoTest(0);
+end;
+
+procedure TTestInt64.TestClone;
+
+Var
+  I : TJSONInt64Number;
+  D : TJSONData;
+
+begin
+  I:=TJSONInt64Number.Create(99);
+  try
+    D:=I.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(TJSONInt64Number(D).NumberType));
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+
+end;
+
+procedure TTestInt64.TestMyClone;
+Var
+  I : TMyInt64;
+  D : TJSONData;
+
+begin
+  I:=TMyInt64.Create(99);
+  try
+    D:=I.Clone;
+    try
+      AssertEquals('Correct class',TMyInt64,D.ClassType);
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntInt64',ord(ntInt64),Ord(TMyInt64(D).NumberType));
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+procedure TTestInt64.TestFormat;
+Var
+  I : TJSONInt64Number;
+
+begin
+  I:=TJSONInt64Number.Create(99);
+  try
+    AssertEquals('FormatJSON equal to JSON',I.AsJSON,I.FormatJSON);
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+{ TTestQWord }
+
+procedure TTestQWord.DoTest(Q: QWord);
+
+Var
+  J : TJSONQWordNumber;
+
+begin
+  J:=TJSONQWordNumber.Create(Q);
+  try
+    TestJSONType(J,jtNumber);
+    TestItemCount(J,0);
+    AssertEquals('Numbertype is ntQWord',ord(ntQWord),Ord(J.NumberType));
+    TestJSON(J,IntToStr(Q));
+    TestIsNull(J,False);
+    TestAsBoolean(J,(Q<>0));
+    TestAsInteger(J,Q);
+    TestAsInt64(J,Q);
+    TestAsQword(J,Q);
+    TestAsString(J,IntToStr(Q));
+    TestAsFloat(J,Q);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestQWord.TestPositive;
+
+begin
+  DoTest(1);
+end;
+
+
+procedure TTestQWord.TestZero;
+begin
+  DoTest(0);
+end;
+
+procedure TTestQWord.TestClone;
+
+Var
+  I : TJSONQWordNumber;
+  D : TJSONData;
+
+begin
+  I:=TJSONQWordNumber.Create(99);
+  try
+    D:=I.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntQWord',ord(ntQWord),Ord(TJSONQWordNumber(D).NumberType));
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+
+end;
+
+procedure TTestQWord.TestMyClone;
+Var
+  I : TMyQWord;
+  D : TJSONData;
+
+begin
+  I:=TMyQWord.Create(99);
+  try
+    D:=I.Clone;
+    try
+      AssertEquals('Correct class',TMyQWord,D.ClassType);
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntQWord',ord(ntQWord),Ord(TMyQWord(D).NumberType));
+     TestAsInteger(D,99);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+procedure TTestQWord.TestFormat;
+Var
+  I : TJSONQWordNumber;
+
+begin
+  I:=TJSONQWordNumber.Create(99);
+  try
+    AssertEquals('FormatJSON equal to JSON',I.AsJSON,I.FormatJSON);
+  finally
+    FreeAndNil(I);
+  end;
+end;
+
+{ TTestFloat }
+
+procedure TTestFloat.DoTest(F: TJSONFloat);
+
+Var
+  J : TJSONFloatNumber;
+  S : String;
+  
+begin
+  Str(F,S);
+  If S[1]=' ' then
+    Delete(S,1,1);
+  J:=TJSONFloatNumber.Create(F);
+  try
+    TestJSONType(J,jtNumber);
+    TestItemCount(J,0);
+    AssertEquals('Numbertype is ntFloat',ord(ntFloat),Ord(J.NumberType));
+    TestJSON(J,S);
+    TestIsNull(J,False);
+    TestAsBoolean(J,(F<>0));
+    TestAsInteger(J,Round(F));
+    TestAsInt64(J,Round(F));
+    TestAsQword(J,Round(F));
+    TestAsString(J,S);
+    TestAsFloat(J,F);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestFloat.TestPositive;
+begin
+  DoTest(1.0);
+  DoTest(1.2);
+  DoTest(1.2e1);
+  DoTest(1.2e-1);
+  DoTest(1.2e10);
+  DoTest(1.2e-10);
+end;
+
+procedure TTestFloat.TestNegative;
+begin
+  DoTest(-1.0);
+  DoTest(-1.2);
+  DoTest(-1.2e1);
+  DoTest(-1.2e-1);
+  DoTest(-1.2e10);
+  DoTest(-1.2e-10);
+end;
+
+procedure TTestFloat.TestZero;
+begin
+  DoTest(0.0);
+end;
+
+procedure TTestFloat.TestClone;
+
+Var
+  F : TJSONFloatNumber;
+  D : TJSONData;
+
+begin
+  F:=TJSONFloatNumber.Create(1.23);
+  try
+    D:=F.Clone;
+    try
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntFloat',ord(ntFloat),Ord(TJSONFloatNumber(D).NumberType));
+     TestAsFloat(D,1.23);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(F);
+  end;
+
+end;
+
+procedure TTestFloat.TestMyClone;
+
+Var
+  F : TMyFloat;
+  D : TJSONData;
+
+begin
+  F:=TMyFloat.Create(1.23);
+  try
+    D:=F.Clone;
+    try
+     AssertEquals('Correct class',TMyFloat,D.ClassType);
+     TestJSONType(D,jtNumber);
+     AssertEquals('Numbertype is ntFloat',ord(ntFloat),Ord(TMyFloat(D).NumberType));
+     TestAsFloat(D,1.23);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(F);
+  end;
+end;
+
+procedure TTestFloat.TestFormat;
+
+Var
+  F : TJSONFloatNumber;
+
+
+begin
+  F:=TJSONFloatNumber.Create(1.23);
+  try
+    AssertEquals('FormatJSON equals asJSON',F.AsJSON,F.FormatJSON);
+  finally
+    FreeAndNil(F);
+  end;
+end;
+
+{ TTestArray }
+
+procedure TTestArray.TestCreate;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,0);
+    TestJSON(J,'[]');
+    TestIsNull(J,False);
+    TestAsBoolean(J,False,True);
+    TestAsInteger(J,1,True);
+    TestAsInt64(J,1,True);
+    TestAsQWord(J,1,True);
+    TestAsString(J,'',True);
+    TestAsFloat(J,0.0,True);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateString;
+
+Const
+  S = 'A string';
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([S]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtString);
+    TestJSON(J,'["'+S+'"]');
+    TestIsNull(J,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreatePchar;
+
+Const
+  S = 'A string';
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([Pchar(S)]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtString);
+    TestJSON(J,'["'+S+'"]');
+    TestIsNull(J,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateStrings;
+
+Const
+  S = 'A string';
+  T = 'B string';
+  
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSONArray.Create([S,T]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtString);
+    TestJSONType(J[1],jtString);
+    TestJSON(J,'["'+S+'", "'+T+'"]');
+    TestIsNull(J,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateStringsCompressed;
+Const
+  S = 'A string';
+  T = 'B string';
+
+Var
+  J : TJSONArray;
+
+begin
+  TJSONData.CompressedJSON:=True;
+  J:=TJSONArray.Create([S,T]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtString);
+    TestJSONType(J[1],jtString);
+    TestJSON(J,'["'+S+'","'+T+'"]');
+    TestIsNull(J,False);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateInteger;
+
+Const
+  S = 3;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([S]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    TestJSON(J,'[3]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateFloat;
+
+Const
+  S : double = 1.2;
+
+Var
+  J : TJSONArray;
+  r : String;
+  
+begin
+  J:=TJSonArray.Create([S]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    Str(S,R);
+    Delete(R,1,1);
+    TestJSON(J,'['+R+']');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateInt64;
+
+Const
+  S : Int64 = $FFFFFFFFFFFFF;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([S]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    TestJSON(J,'['+IntToStr(S)+']');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateBoolean;
+
+Const
+  S = True;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([S]);
+  try
+    TestJSONType(J,jtArray);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtBoolean);
+    TestJSON(J,'[true]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateJSONObject;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([TJSONObject.Create]);
+  try
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtObject);
+    TestJSON(J,'[{}]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+procedure TTestArray.TestCreateJSONString;
+
+Const
+  S = 'A string';
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create([TJSONString.Create(S)]);
+  try
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtString);
+    TestJSON(J,'["'+S+'"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreateObject;
+
+Var
+  J : TJSONArray;
+  O : TObject;
+  
+begin
+  J:=Nil;
+  try
+    Try
+      O:=TObject.Create;
+      J:=TJSONArray.Create([O]);
+      Fail('Array constructor accepts only TJSONData');
+    finally
+      FreeAndNil(J);
+      FreeAndNil(O);
+    end;
+  except
+    // Should be OK.
+  end;
+end;
+
+procedure TTestArray.TestCreateNilPointer;
+
+Var
+  J : TJSONArray;
+  P : Pointer;
+  
+begin
+  J:=Nil;
+  P:=Nil;
+  Try
+    J:=TJSONArray.Create([P]);
+    TestJSONType(J[0],jtNull);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestCreatePointer;
+
+Var
+  J : TJSONArray;
+  P : Pointer;
+  
+begin
+  J:=Nil;
+  P:=@Self;
+  try
+    Try
+      J:=TJSONArray.Create([P]);
+      Fail('Array constructor accepts only NIL pointers');
+    finally
+      FreeAndNil(J);
+    end;
+  except
+    // Should be OK.
+  end;
+end;
+
+procedure TTestArray.TestAddInteger;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Integer(0));
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONIntegerNumber',J[0].ClassType,TJSONIntegerNumber);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Integers[0]=0',0,J.integers[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestAsQword(J[0],0);
+    TestJSON(J,'[0]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddInt64;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Int64(0));
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONInt64Number',J[0].ClassType,TJSONInt64Number);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Int64s[0]=0',0,J.Int64s[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestAsQword(J[0],0);
+    TestJSON(J,'[0]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddFloat;
+
+Var
+  J : TJSONArray;
+  S : String;
+  F : TJSONFloat;
+begin
+  F:=1.2;
+  J:=TJSonArray.Create;
+  try
+    J.Add(F);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONFloatNumber',TJSONfloatNumber,J[0].ClassType);
+    AssertEquals('j.Types[0]=jtNumber',Ord(jtNumber),ord(J.Types[0]));
+    AssertEquals('J.Floats[0]='+FloatToStr(F),F,J.Floats[0]);
+    TestAsFloat(J[0],F);
+    Str(F,S);
+    Delete(S,1,1);
+    TestJSON(J,'['+S+']');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddBoolean(B : Boolean);
+
+Var
+  J : TJSONArray;
+
+begin
+  B:=True;
+  J:=TJSonArray.Create;
+  try
+    J.Add(B);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtBoolean);
+    AssertEquals('J[0] is TJSONBoolean',TJSONBoolean,J[0].ClassType);
+    TestAsBoolean(J[0],B);
+    AssertEquals('J.Booleans[0]='+BoolToStr(B)+'"',B,J.Booleans[0]);
+    If B then
+      TestJSON(J,'[true]')
+    else
+      TestJSON(J,'[false]');
+  finally
+    FreeAndNil(J);
+  end;
+
+end;
+
+procedure TTestArray.TestInsertBoolean(B: Boolean);
+Var
+  J : TJSONArray;
+
+begin
+  B:=True;
+  J:=TJSonArray.Create;
+  try
+    J.Add(Not B);
+    J.Insert(0,B);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtBoolean);
+    AssertEquals('J[0] is TJSONBoolean',TJSONBoolean,J[0].ClassType);
+    TestAsBoolean(J[0],B);
+    AssertEquals('J.Booleans[0]='+BoolToStr(B)+'"',B,J.Booleans[0]);
+    If B then
+      TestJSON(J,'[true, false]')
+    else
+      TestJSON(J,'[false, true]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddBooleanTrue;
+
+begin
+  TestAddBoolean(True);
+end;
+
+procedure TTestArray.TestAddBooleanFalse;
+
+begin
+  TestAddBoolean(False);
+end;
+
+procedure TTestArray.TestAddString;
+
+Var
+  J : TJSONArray;
+  S : String;
+  
+begin
+  S:='A string';
+  J:=TJSonArray.Create;
+  try
+    J.Add(S);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtString);
+    AssertEquals('J[0] is TJSONString',TJSONString,J[0].ClassType);
+    TestAsString(J[0],S);
+    AssertEquals('J.Strings[0]="'+S+'"',S,J.Strings[0]);
+    TestJSON(J,'["'+StringToJSONString(S)+'"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddNull;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add;
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtNull);
+    AssertEquals('J[0] is TJSONNull',TJSONNull,J[0].ClassType);
+    AssertEquals('J.Nulls[0]=True',True,J.Nulls[0]);
+    TestIsNull(J[0],true);
+    TestJSON(J,'[null]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddArray;
+
+Var
+  J,J2 : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J2:=TJSonArray.Create;
+    J2.Add(0);
+    J2.Add(1);
+    J.Add(J2);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtArray);
+    AssertEquals('J[0] is TJSONArray',TJSONArray,J[0].ClassType);
+    AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[0].ClassType);
+    TestAsInteger(J.Arrays[0][0],0);
+    TestAsInteger(J.Arrays[0][1],1);
+    TestAsInt64(J.Arrays[0][0],0);
+    TestAsInt64(J.Arrays[0][1],1);
+    TestAsQword(J.Arrays[0][0],0);
+    TestAsQword(J.Arrays[0][1],1);
+    TestJSON(J,'[[0, 1]]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertInteger;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Integer(1));
+    J.Insert(0,Integer(0));
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONIntegerNumber',J[0].ClassType,TJSONIntegerNumber);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Integers[0]=0',0,J.integers[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestAsQword(J[0],0);
+    TestJSON(J,'[0, 1]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertInt64;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Int64(1));
+    J.Insert(0,Int64(0));
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONInt64Number',J[0].ClassType,TJSONInt64Number);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Int64s[0]=0',0,J.Int64s[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestAsQword(J[0],0);
+    TestJSON(J,'[0, 1]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertFloat;
+Var
+  J : TJSONArray;
+  S,S2 : String;
+  F : TJSONFloat;
+begin
+  F:=1.2;
+  J:=TJSonArray.Create;
+  try
+    J.Add(2.3);
+    J.Insert(0,F);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONFloatNumber',TJSONfloatNumber,J[0].ClassType);
+    AssertEquals('j.Types[0]=jtNumber',Ord(jtNumber),ord(J.Types[0]));
+    AssertEquals('J.Floats[0]='+FloatToStr(F),F,J.Floats[0]);
+    TestAsFloat(J[0],F);
+    Str(F,S);
+    Delete(S,1,1);
+    F:=2.3;
+    Str(F,S2);
+    Delete(S2,1,1);
+    TestJSON(J,'['+S+', '+S2+']');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertBooleanTrue;
+begin
+  TestInsertBoolean(True);
+end;
+
+procedure TTestArray.TestInsertBooleanFalse;
+begin
+  TestInsertBoolean(False);
+end;
+
+procedure TTestArray.TestInsertString;
+
+Var
+  J : TJSONArray;
+  S : String;
+
+begin
+  S:='A string';
+  J:=TJSonArray.Create;
+  try
+    J.Add('Another string');
+    J.Insert(0,S);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtString);
+    AssertEquals('J[0] is TJSONString',TJSONString,J[0].ClassType);
+    TestAsString(J[0],S);
+    AssertEquals('J.Strings[0]="'+S+'"',S,J.Strings[0]);
+    TestJSON(J,'["'+StringToJSONString(S)+'", "Another string"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertNull;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(123);
+    J.Insert(0);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNull);
+    AssertEquals('J[0] is TJSONNull',TJSONNull,J[0].ClassType);
+    AssertEquals('J.Nulls[0]=True',True,J.Nulls[0]);
+    TestIsNull(J[0],true);
+    TestJSON(J,'[null, 123]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertObject;
+Const
+  A = 'a';
+  B = 'b';
+
+Var
+  J : TJSONArray;
+  J2 : TJSONObject;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('A string');
+    J2:=TJSonObject.Create;
+    J2.Add(A,0);
+    J2.Add(B,1);
+    J.Insert(0,J2);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtObject);
+    AssertEquals('J[0] is TJSONObject',TJSONObject,J[0].ClassType);
+    AssertEquals('J.Objects[0] is TJSONObject',TJSONObject,J.Objects[0].ClassType);
+    TestAsInteger(J.Objects[0][A],0);
+    TestAsInteger(J.Objects[0][B],1);
+    TestAsInt64(J.Objects[0][A],0);
+    TestAsInt64(J.Objects[0][B],1);
+    TestAsQword(J.Objects[0][A],0);
+    TestAsQword(J.Objects[0][B],1);
+    TestJSON(J,'[{ "a" : 0, "b" : 1 }, "A string"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertArray;
+Var
+  J,J2 : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('Something nice');
+    J2:=TJSonArray.Create;
+    J2.Add(0);
+    J2.Add(1);
+    J.Insert(0,J2);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtArray);
+    AssertEquals('J[0] is TJSONArray',TJSONArray,J[0].ClassType);
+    AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[0].ClassType);
+    TestAsInteger(J.Arrays[0][0],0);
+    TestAsInteger(J.Arrays[0][1],1);
+    TestAsInt64(J.Arrays[0][0],0);
+    TestAsInt64(J.Arrays[0][1],1);
+    TestAsQWord(J.Arrays[0][0],0);
+    TestAsQWord(J.Arrays[0][1],1);
+    TestJSON(J,'[[0, 1], "Something nice"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestMove;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('First string');
+    J.Add('Second string');
+    J.Add('Third string');
+    J.Move(2,1);
+    TestItemCount(J,3);
+    AssertEquals('J[2] is TJSONString',TJSONString,J[1].ClassType);
+    AssertEquals('J[1] is TJSONString',TJSONString,J[2].ClassType);
+    TestAsString(J[1],'Third string');
+    TestAsString(J[2],'Second string');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestExchange;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('First string');
+    J.Add('Second string');
+    J.Add('Third string');
+    J.Exchange(2,0);
+    TestItemCount(J,3);
+    AssertEquals('J[2] is TJSONString',TJSONString,J[0].ClassType);
+    AssertEquals('J[1] is TJSONString',TJSONString,J[2].ClassType);
+    TestAsString(J[0],'Third string');
+    TestAsString(J[2],'First string');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestAddObject;
+
+Const
+  A = 'a';
+  B = 'b';
+  
+Var
+  J : TJSONArray;
+  J2 : TJSONObject;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J2:=TJSonObject.Create;
+    J2.Add(A,0);
+    J2.Add(B,1);
+    J.Add(J2);
+    TestItemCount(J,1);
+    TestJSONType(J[0],jtObject);
+    AssertEquals('J[0] is TJSONObject',TJSONObject,J[0].ClassType);
+    AssertEquals('J.Objects[0] is TJSONObject',TJSONObject,J.Objects[0].ClassType);
+    TestAsInteger(J.Objects[0][A],0);
+    TestAsInteger(J.Objects[0][B],1);
+    TestAsInt64(J.Objects[0][A],0);
+    TestAsInt64(J.Objects[0][B],1);
+    TestAsQword(J.Objects[0][A],0);
+    TestAsQword(J.Objects[0][B],1);
+    TestJSON(J,'[{ "a" : 0, "b" : 1 }]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestDelete;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(0);
+    J.Add(1);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    TestJSONType(J[1],jtNumber);
+    TestJSON(J,'[0, 1]');
+    J.Delete(1);
+    TestItemCount(J,1);
+    J.Delete(0);
+    TestItemCount(J,0);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestRemove;
+
+Var
+  J : TJSONArray;
+  I : TJSONData;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(0);
+    J.Add(1);
+    J.Add(2);
+    TestItemCount(J,3);
+    TestJSONType(J[0],jtNumber);
+    TestJSONType(J[1],jtNumber);
+    TestJSONType(J[2],jtNumber);
+    TestJSON(J,'[0, 1, 2]');
+    I:=J[1];
+    J.Remove(I);
+    TestItemCount(J,2);
+    TestAsInteger(J[0],0);
+    TestAsInteger(J[1],2);
+    TestAsInt64(J[0],0);
+    TestAsInt64(J[1],2);
+    TestAsQWord(J[0],0);
+    TestAsQWord(J[1],2);
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestClone;
+
+Var
+  J,J2 : TJSONArray;
+  D : TJSONData;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(1);
+    J.Add('aloha');
+    D:=J.Clone;
+    try
+      TestJSONType(D,jtArray);
+      J2:=TJSonArray(D);
+      TestItemCount(J2,2);
+      TestJSONType(J2[0],jtNumber);
+      TestJSONType(J2[1],jtString);
+      TestAsInteger(J2[0],1);
+      TestAsString(J2[1],'aloha');
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestMyClone;
+Var
+  J : TMyArray;
+  D : TJSONData;
+
+begin
+  J:=TMyArray.Create;
+  try
+    J.Add(1);
+    J.Add('aloha');
+    D:=J.Clone;
+    try
+      TestJSONType(D,jtArray);
+      AssertEquals('Correct class',TMyArray,D.ClassType);
+    finally
+      D.Free;
+    end;
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestFormat;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(0);
+    J.Add(1);
+    J.Add(2);
+    TestItemCount(J,3);
+    TestJSONType(J[0],jtNumber);
+    TestJSONType(J[1],jtNumber);
+    TestJSONType(J[2],jtNumber);
+    TestJSON(J,'[0, 1, 2]');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineArray],1));
+    AssertEquals('FormatJSON, default','['+sLinebreak+'  0,'+sLinebreak+'  1,'+sLinebreak+'  2'+sLinebreak+']',J.FormatJSON());
+    AssertEquals('FormatJSON, use tab','['+sLinebreak+#9'0,'+sLinebreak+#9'1,'+sLinebreak+#9'2'+sLinebreak+']',J.FormatJSON([foUseTabChar],1));
+    J.Add(TJSONObject.Create(['x',1,'y',2]));
+    AssertEquals('FormatJSON, use tab indentsize 1','['+sLinebreak+#9'0,'+sLinebreak+#9'1,'+sLinebreak+#9'2,'+sLinebreak+#9'{'+sLineBreak+#9#9'"x" : 1,'+sLineBreak+#9#9'"y" : 2'+sLinebreak+#9'}'+sLineBreak+']',J.FormatJSON([foUseTabChar],1));
+  finally
+    J.Free
+  end;
+end;
+
+procedure TTestArray.TestFormatNil;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(1);
+    J.Add(TJSONObject(Nil));
+    TestJSON(J,'[1, null]');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineArray],1));
+  finally
+    J.Free;
+  end;
+end;
+
+{ TTestObject }
+
+procedure TTestObject.TestCreate;
+
+begin
+  TestJSONType(J,jtObject);
+  TestItemCount(J,0);
+  TestJSON(J,'{}');
+  TestIsNull(J,False);
+  TestAsBoolean(J,False,True);
+  TestAsInteger(J,1,True);
+  TestAsInt64(J,1,True);
+  TestAsQword(J,1,True);
+  TestAsString(J,'',True);
+  TestAsFloat(J,0.0,True);
+end;
+
+procedure TTestObject.TestAddInteger;
+
+Const
+  A = 'a';
+
+begin
+  J.Add(A,Integer(0));
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtNumber);
+  AssertEquals('J[''a''] is TJSONIntegerNumber',J[A].ClassType,TJSONIntegerNumber);
+  AssertEquals('j.Types[''a'']=jtNumber',ord(J.Types[A]),Ord(jtNumber));
+  AssertEquals('J.Integers[''a'']=0',0,J.integers[A]);
+  TestAsInteger(J[A],0);
+  TestAsInt64(J[A],0);
+  TestAsQword(J[A],0);
+  TestJSON(J,'{ "'+A+'" : 0 }');
+end;
+
+procedure TTestObject.TestAddInt64;
+
+Const
+  A = 'a';
+
+begin
+  J.Add(A,Int64(0));
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtNumber);
+  AssertEquals('J[''a''] is TJSONInt64Number',J[A].ClassType,TJSONInt64Number);
+  AssertEquals('j.Types[''a'']=jtNumber',ord(J.Types[A]),Ord(jtNumber));
+  AssertEquals('J.Int64s[''a'']=0',0,J.Int64s[A]);
+  TestAsInteger(J[A],0);
+  TestAsInt64(J[A],0);
+  TestAsQword(J[A],0);
+  TestJSON(J,'{ "'+A+'" : 0 }');
+end;
+
+procedure TTestObject.TestAddFloat;
+
+Const
+  A = 'a';
+
+Var
+  S : String;
+  F : TJSONFloat;
+begin
+  F:=1.2;
+  J.Add(A,F);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtNumber);
+  AssertEquals('J[''a''] is TJSONFloatNumber',TJSONfloatNumber,J[a].ClassType);
+  AssertEquals('j.Types[''a'']=jtNumber',Ord(jtNumber),ord(J.Types[a]));
+  AssertEquals('J.Floats[''a'']='+FloatToStr(F),F,J.Floats[a]);
+  TestAsFloat(J[A],F);
+  Str(F,S);
+  TestJSON(J,'{ "'+a+'" :'+S+' }');
+end;
+
+procedure TTestObject.Setup;
+begin
+  inherited Setup;
+  FJ:=TJSONObject.Create;
+end;
+
+procedure TTestObject.TearDown;
+begin
+  FreeAndNil(FJ);
+  inherited TearDown;
+end;
+
+procedure TTestObject.TestAddBoolean(B : Boolean);
+
+Const
+  A = 'a';
+  
+begin
+  B:=True;
+  J.Add(A,B);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtBoolean);
+  AssertEquals('J[''a''] is TJSONBoolean',TJSONBoolean,J[a].ClassType);
+  TestAsBoolean(J[a],B);
+  AssertEquals('J.Booleans[''a'']='+BoolToStr(B)+'"',B,J.Booleans[a]);
+  If B then
+    TestJSON(J,'{ "'+a+'" : true }')
+  else
+    TestJSON(J,'{ "'+a+'" : false }');
+end;
+
+procedure TTestObject.TestAccessError;
+
+begin
+  J.Strings['NonExist'];
+end;
+
+procedure TTestObject.TestAddBooleanTrue;
+
+begin
+  TestAddBoolean(True);
+end;
+
+procedure TTestObject.TestAddBooleanFalse;
+
+begin
+  TestAddBoolean(False);
+end;
+
+procedure TTestObject.TestAddString;
+
+Const
+  A = 'a';
+
+Var
+  S : String;
+
+begin
+  S:='A string';
+    J.Add(A,S);
+    TestItemCount(J,1);
+    TestJSONType(J[a],jtString);
+    AssertEquals('J[''a''] is TJSONString',TJSONString,J[A].ClassType);
+    TestAsString(J[a],S);
+    AssertEquals('J.Strings[''a'']="'+S+'"',S,J.Strings[A]);
+    TestJSON(J,'{ "'+a+'" : "'+StringToJSONString(S)+'" }');
+end;
+
+procedure TTestObject.TestAddNull;
+
+Const
+  A = 'a';
+
+begin
+  J.Add(a);
+  TestItemCount(J,1);
+  TestJSONType(J[a],jtNull);
+  AssertEquals('J[''a''] is TJSONNull',TJSONNull,J[A].ClassType);
+  AssertEquals('J.Nulls[''a'']=True',True,J.Nulls[A]);
+  TestIsNull(J[a],true);
+  TestJSON(J,'{ "'+a+'" : null }');
+end;
+
+procedure TTestObject.TestAddObject;
+
+Const
+  A = 'a';
+  B = 'b';
+  C = 'c';
+
+Var
+  J2 : TJSONObject;
+
+begin
+  J2:=TJSonObject.Create;
+  J2.Add(B,0);
+  J2.Add(C,1);
+  J.Add(A,J2);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtObject);
+  AssertEquals('J[''a''] is TJSONObject',TJSONObject,J[A].ClassType);
+  AssertEquals('J.Objects[''a''] is TJSONObject',TJSONObject,J.Objects[A].ClassType);
+  TestAsInteger(J.Objects[A][B],0);
+  TestAsInteger(J.Objects[A][C],1);
+  TestAsInt64(J.Objects[A][B],0);
+  TestAsInt64(J.Objects[A][C],1);
+  TestAsQword(J.Objects[A][B],0);
+  TestAsQword(J.Objects[A][C],1);
+  TestJSON(J,'{ "a" : { "b" : 0, "c" : 1 } }');
+end;
+
+procedure TTestObject.TestAddArray;
+
+Const
+  A = 'a';
+
+Var
+  J2 : TJSONArray;
+
+begin
+  J2:=TJSonArray.Create;
+  J2.Add(0);
+  J2.Add(1);
+  J.Add(A,J2);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtArray);
+  AssertEquals('J[''a''] is TJSONArray',TJSONArray,J[A].ClassType);
+  AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[A].ClassType);
+  TestAsInteger(J.Arrays[A][0],0);
+  TestAsInteger(J.Arrays[A][1],1);
+  TestAsInt64(J.Arrays[A][0],0);
+  TestAsInt64(J.Arrays[A][1],1);
+  TestAsQword(J.Arrays[A][0],0);
+  TestAsQword(J.Arrays[A][1],1);
+  TestJSON(J,'{ "a" : [0, 1] }');
+end;
+
+procedure TTestObject.TestDelete;
+
+Const
+  A = 'a';
+  B = 'b';
+  
+begin
+  J.Add(A,0);
+  J.Add(B,1);
+  TestItemCount(J,2);
+  TestJSONType(J[A],jtNumber);
+  TestJSONType(J[A],jtNumber);
+  TestJSON(J,'{ "a" : 0, "b" : 1 }');
+  J.Delete(1);
+  TestItemCount(J,1);
+  J.Delete(0);
+  TestItemCount(J,0);
+end;
+
+procedure TTestObject.TestRemove;
+
+Const
+  A = 'a';
+  B = 'b';
+  C = 'c';
+  
+Var
+  I : TJSONData;
+
+begin
+  J.Add(A,1);
+  J.Add(B,2);
+  J.Add(C,3);
+  TestItemCount(J,3);
+  TestJSONType(J[A],jtNumber);
+  TestJSONType(J[B],jtNumber);
+  TestJSONType(J[C],jtNumber);
+  TestJSON(J,'{ "a" : 1, "b" : 2, "c" : 3 }');
+  I:=J[b];
+  J.Remove(I);
+  TestItemCount(J,2);
+  TestAsInteger(J[a],1);
+  TestAsInteger(J[c],3);
+  TestAsInt64(J[a],1);
+  TestAsInt64(J[c],3);
+  TestAsQword(J[a],1);
+  TestAsQword(J[c],3);
+end;
+
+procedure TTestObject.TestClone;
+
+Var
+  J2 : TJSONObject;
+  D : TJSONData;
+
+begin
+  J.Add('p1',1);
+  J.Add('p2','aloha');
+  D:=J.Clone;
+  try
+    TestJSONType(D,jtObject);
+    J2:=TJSonObject(D);
+    TestItemCount(J2,2);
+    TestJSONType(J2['p1'],jtNumber);
+    TestJSONType(J2['p2'],jtString);
+    TestAsInteger(J2['p1'],1);
+    TestAsString(J2['p2'],'aloha');
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TTestObject.TestMyClone;
+
+Var
+  D : TJSONData;
+  O : TMyObject;
+
+begin
+  D:=Nil;
+  O:=TMyObject.Create;
+  try
+    O.Add('p1',1);
+    O.Add('p2','aloha');
+    D:=O.Clone;
+    TestJSONType(D,jtObject);
+    AssertEquals('Correct class',TMYObject,D.ClassType);
+  finally
+    D.Free;
+    O.Free;
+  end;
+end;
+
+procedure TTestObject.TestExtract;
+
+Const
+  A = 'a';
+  B = 'b';
+
+Var
+  JA,JB : TJSONData;
+  E : TJSONData;
+
+begin
+  J.Add(A,0);
+  J.Add(B,1);
+  TestItemCount(J,2);
+  JA:=J[A];
+  JB:=J[B];
+  TestJSONType(JA,jtNumber);
+  TestJSONType(JB,jtNumber);
+  TestJSON(J,'{ "a" : 0, "b" : 1 }');
+  E:=J.Extract(1);
+  AssertSame('Extracted JA',JB,E);
+  E.Free;
+  TestItemCount(J,1);
+  E:=J.Extract(0);
+  AssertSame('Extracted JB',JA,E);
+  E.Free;
+  TestItemCount(J,0);
+end;
+
+procedure TTestObject.TestNonExistingAccessError;
+begin
+  AssertException(EJSON,@TestAccessError);
+end;
+
+procedure TTestObject.TestFormat;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create(['x',1,'y',2]);
+  try
+    TestJSON(O,'{ "x" : 1, "y" : 2 }');
+    AssertEquals('Format equals JSON',O.AsJSON,O.FormatJSON([foSingleLineObject]));
+    AssertEquals('Format using SkipWhiteSpace','{"x":1,"y":2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace]));
+    AssertEquals('Format using SkipWhiteSpace,foSkipWhiteSpaceOnlyLeading','{"x": 1,"y": 2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace,foSkipWhiteSpaceOnlyLeading]));
+    AssertEquals('Format using SkipWhiteSpace,unquotednames','{x:1,y:2}',O.FormatJSON([foSingleLineObject,foSkipWhiteSpace,foDoNotQuoteMembers]));
+    AssertEquals('Format []','{'+sLineBreak+'  "x" : 1,'+sLineBreak+'  "y" : 2'+sLineBreak+'}',O.FormatJSON([]));
+    AssertEquals('Format [foDoNotQuoteMembers]','{'+sLineBreak+'  x : 1,'+sLineBreak+'  y : 2'+sLineBreak+'}',O.FormatJSON([foDoNotQuoteMembers]));
+    AssertEquals('Format [foUseTabChar,foDoNotQuoteMembers]','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+    O.Add('s',TJSONObject.Create(['w',10,'h',20]));
+    AssertEquals('Format [foUseTabChar,foDoNotQuoteMembers] 2','{'+sLineBreak+#9'x : 1,'+sLineBreak+#9'y : 2,'+sLineBreak+#9's : {'+sLineBreak+#9#9'w : 10,'+sLineBreak+#9#9'h : 20'+sLineBreak+#9'}'+sLineBreak+'}',O.FormatJSON([foUseTabChar,foDoNotQuoteMembers],1));
+  finally
+    O.Free;
+  end;
+end;
+
+procedure TTestObject.TestFormatNil;
+
+begin
+  J.Add('a',1);
+  J.Add('b',TJSONObject(Nil));
+  TestJSON(J,'{ "a" : 1, "b" : null }');
+  AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineObject],1));
+end;
+
+procedure TTestObject.TestFind;
+
+Const
+  A = 'A';
+  S = 'A string';
+  B = 'a';
+  S2 = 'Another string';
+  C = 'c';
+  S3 = 'Yet Another string';
+
+begin
+  J.Add(A,S);
+  J.Add(B,S2);
+  J.Add(C,S3);
+  TestJSONType(J,jtObject);
+  TestIsNull(J,False);
+  TestItemCount(J,3);
+  TestJSONType(J[A],jtString);
+  TestJSONType(J[B],jtString);
+  TestJSON(J,'{ "A" : "'+S+'", "a" : "'+S2+'", "c" : "'+S3+'" }');
+  AssertEquals('Nonexisting, case sensitive',-1,J.IndexOfName('D'));
+  AssertEquals('Nonexisting, case insensitive',-1,J.IndexOfName('D',True));
+  AssertEquals('1 Existing , case sensitive',0,J.IndexOfName(A));
+  AssertEquals('2 Existing exact match, case insensitive',0,J.IndexOfName(A,true));
+  AssertEquals('3 Existing , case sensitive',1,J.IndexOfName(B));
+  AssertEquals('4 Existing exact match, case insensitive',1,J.IndexOfName(B,true));
+  AssertEquals('5 Existing , case sensitive again',2,J.IndexOfName(C));
+  AssertEquals('6 Existing case-insensitive match, case insensitive',2,J.IndexOfName(Uppercase(C),true));
+end;
+
+Procedure TTestObject.TestIfFind;
+Var
+  B: TJSONBoolean;
+  S: TJSONString;
+  N: TJSONNumber;
+  D: TJSONData;
+begin
+  J.Add('s', 'astring');
+  J.Add('b', true);
+  J.Add('n', 1);
+  TestJSONType(J,jtObject);
+  TestIsNull(J,False);
+  TestItemCount(J,3);
+  AssertEquals('boolean found', true, j.Find('b', B));
+  AssertEquals('string found', true, j.Find('s', S));
+  AssertEquals('number found', true, j.Find('n', N));
+  AssertEquals('data found', true, j.Find('s', D));
+end;
+
+procedure TTestObject.AppendA;
+
+begin
+  J.Add('A','S')
+end;
+
+procedure TTestObject.TestDuplicate;
+
+begin
+  J.Add('A',TJSONObject.Create);
+  AssertException(EJSON,@AppendA);
+end;
+
+
+procedure TTestObject.TestCreateString;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+begin
+  J.Add(A,S);
+  TestJSONType(J,jtObject);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtString);
+  TestJSON(J,'{ "A" : "'+S+'" }');
+  TestIsNull(J,False);
+end;
+
+procedure TTestObject.TestCreateStringUnquoted;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+begin
+  TJSONObject.UnquotedMemberNames:=True;
+  J.Add(A,S);
+  TestJSONType(J,jtObject);
+  TestItemCount(J,1);
+  TestJSONType(J[A],jtString);
+  TestJSON(J,'{ A : "'+S+'" }');
+  TestIsNull(J,False);
+end;
+
+procedure TTestObject.TestCreatePchar;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,Pchar(S)]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtString);
+    TestJSON(O,'{ "A" : "'+S+'" }');
+    TestIsNull(O,False);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreatePcharUnquoted;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,Pchar(S)]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtString);
+    TestJSON(O,'{ A : "'+S+'" }');
+    TestIsNull(O,False);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateStrings;
+
+Const
+  A = 'A';
+  B = 'B';
+  S = 'A string';
+  T = 'B string';
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,S,B,T]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,2);
+    TestJSONType(O[A],jtString);
+    TestJSONType(O[B],jtString);
+    TestJSON(O,'{ "A" : "'+S+'", "B" : "'+T+'" }');
+    TestIsNull(O,False);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateStringsCompressed;
+
+Const
+  A = 'A';
+  B = 'B';
+  S = 'A string';
+  T = 'B string';
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONData.CompressedJSON:=True;
+  O:=TJSONObject.Create([A,S,B,T]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,2);
+    TestJSONType(O[A],jtString);
+    TestJSONType(O[B],jtString);
+    TestJSON(O,'{"A":"'+S+'","B":"'+T+'"}');
+    TestIsNull(O,False);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateStringsCompressedUnquoted;
+
+Const
+  A = 'A';
+  B = 'B';
+  S = 'A string';
+  T = 'B string';
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONData.CompressedJSON:=True;
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,S,B,T]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,2);
+    TestJSONType(O[A],jtString);
+    TestJSONType(O[B],jtString);
+    TestJSON(O,'{A:"'+S+'",B:"'+T+'"}');
+    TestIsNull(O,False);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateInteger;
+
+Const
+  A = 'A';
+  S = 3;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    TestJSON(O,'{ "A" : 3 }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateIntegerUnquoted;
+Const
+  A = 'A';
+  S = 3;
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    TestJSON(O,'{ A : 3 }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateFloat;
+
+Const
+  A = 'A';
+  S : double = 1.2;
+
+Var
+  O : TJSONObject;
+  r : String;
+
+begin
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    Str(S,R);
+    TestJSON(O,'{ "A" :'+R+' }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateFloatUnquoted;
+Const
+  A = 'A';
+  S : double = 1.2;
+
+Var
+  O : TJSONObject;
+  r : String;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    Str(S,R);
+    TestJSON(O,'{ A :'+R+' }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateInt64;
+
+Const
+  A = 'A';
+  S : Int64 = $FFFFFFFFFFFFF;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    TestJSON(O,'{ "A" : '+IntToStr(S)+' }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateInt64Unquoted;
+Const
+  A = 'A';
+  S : Int64 = $FFFFFFFFFFFFF;
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtNumber);
+    TestJSON(O,'{ A : '+IntToStr(S)+' }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateBoolean;
+
+Const
+  A = 'A';
+  S = True;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtBoolean);
+    TestJSON(O,'{ "A" : true }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateBooleanUnquoted;
+Const
+  A = 'A';
+  S = True;
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,S]);
+  try
+    TestJSONType(O,jtObject);
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtBoolean);
+    TestJSON(O,'{ A : true }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateJSONObject;
+
+Const
+  A = 'A';
+  
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,TJSONObject.Create]);
+  try
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtObject);
+    TestJSON(O,'{ "A" : {} }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateJSONObjectUnquoted;
+Const
+  A = 'A';
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,TJSONObject.Create]);
+  try
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtObject);
+    TestJSON(O,'{ A : {} }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateJSONString;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=TJSONObject.Create([A,TJSONString.Create(S)]);
+  try
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtString);
+    TestJSON(O,'{ "A" : "'+S+'" }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateJSONStringUnquoted;
+
+Const
+  A = 'A';
+  S = 'A string';
+
+Var
+  O : TJSONObject;
+
+begin
+  TJSONObject.UnQuotedMemberNames:=True;
+  O:=TJSONObject.Create([A,TJSONString.Create(S)]);
+  try
+    TestItemCount(O,1);
+    TestJSONType(O[A],jtString);
+    TestJSON(O,'{ A : "'+S+'" }');
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreateObject;
+
+Const
+  A = 'A';
+
+Var
+  O : TJSONObject;
+  OO : TObject;
+
+begin
+  O:=Nil;
+  try
+    Try
+      OO:=TObject.Create;
+      O:=TJSONObject.Create([A,OO]);
+      Fail('Array constructor accepts only TJSONData');
+    finally
+      FreeAndNil(O);
+      FreeAndNil(OO);
+    end;
+  except
+    // Should be OK.
+  end;
+end;
+
+procedure TTestObject.TestCreateNilPointer;
+
+Const
+  A = 'A';
+
+Var
+  O : TJSONObject;
+  P : Pointer;
+
+begin
+  O:=Nil;
+  P:=Nil;
+  Try
+    O:=TJSONObject.Create([A,P]);
+    TestJSONType(O[A],jtNull);
+  finally
+    FreeAndNil(O);
+  end;
+end;
+
+procedure TTestObject.TestCreatePointer;
+
+Const
+  A = 'A';
+
+Var
+  O : TJSONObject;
+  P : Pointer;
+
+begin
+  O:=Nil;
+  P:=@Self;
+  try
+    Try
+      O:=TJSONObject.Create([A,P]);
+      Fail('Array constructor accepts only NIL pointers');
+    finally
+      FreeAndNil(O);
+    end;
+  except
+    // Should be OK.
+  end;
+end;
+
+{ TTestJSONString }
+
+procedure TTestJSONString.TestTo(const Src, Dest: String; Strict : Boolean = False);
+
+Var
+  S : String;
+
+begin
+  S:='StringToJSONString('''+Src+''')='''+Dest+'''';
+  AssertEquals(S,Dest,StringToJSONString(Src,Strict));
+end;
+
+procedure TTestJSONString.TestFrom(const Src, Dest: String);
+
+Var
+  S : String;
+
+begin
+  S:='JSONStringToString('''+Src+''')='''+Dest+'''';
+  AssertEquals(S,Dest,JSONStringToString(Src));
+end;
+
+procedure TTestJSONString.TestJSONStringToString;
+
+Const
+  // Glowing star in UTF8
+  GlowingStar = #$F0#$9F#$8C#$9F;
+
+begin
+  TestFrom('','');
+  TestFrom('A','A');
+  TestFrom('AB','AB');
+  TestFrom('ABC','ABC');
+  TestFrom('\\','\');
+  TestFrom('\/','/');
+  TestFrom('\"','"');
+  TestFrom('\b',#8);
+  TestFrom('\t',#9);
+  TestFrom('\n',#10);
+  TestFrom('\f',#12);
+  TestFrom('\r',#13);
+  TestFrom('\bBC',#8'BC');
+  TestFrom('\tBC',#9'BC');
+  TestFrom('\nBC',#10'BC');
+  TestFrom('\fBC',#12'BC');
+  TestFrom('\rBC',#13'BC');
+  TestFrom('A\b','A'#8);
+  TestFrom('A\t','A'#9);
+  TestFrom('A\n','A'#10);
+  TestFrom('A\f','A'#12);
+  TestFrom('A\r','A'#13);
+  TestFrom('A\bBC','A'#8'BC');
+  TestFrom('A\tBC','A'#9'BC');
+  TestFrom('A\nBC','A'#10'BC');
+  TestFrom('A\fBC','A'#12'BC');
+  TestFrom('A\rBC','A'#13'BC');
+  TestFrom('\\\\','\\');
+  TestFrom('\/\/','//');
+  TestFrom('\"\"','""');
+  TestFrom('\b\b',#8#8);
+  TestFrom('\t\t',#9#9);
+  TestFrom('\n\n',#10#10);
+  TestFrom('\f\f',#12#12);
+  TestFrom('\r\r',#13#13);
+  TestFrom('\u00f8','ø'); // this is ø
+  TestFrom('\u00f8\"','ø"'); // this is ø"
+  TestFrom('\ud83c\udf1f',GlowingStar);
+end;
+
+procedure TTestJSONString.TestStringToJSONString;
+begin
+  TestTo('','');
+  TestTo('A','A');
+  TestTo('AB','AB');
+  TestTo('ABC','ABC');
+  TestTo('\','\\');
+  TestTo('/','/');
+  TestTo('/','\/',True);
+  TestTo('"','\"');
+  TestTo(#8,'\b');
+  TestTo(#9,'\t');
+  TestTo(#10,'\n');
+  TestTo(#12,'\f');
+  TestTo(#13,'\r');
+  TestTo(#8'BC','\bBC');
+  TestTo(#9'BC','\tBC');
+  TestTo(#10'BC','\nBC');
+  TestTo(#12'BC','\fBC');
+  TestTo(#13'BC','\rBC');
+  TestTo('A'#8,'A\b');
+  TestTo('A'#9,'A\t');
+  TestTo('A'#10,'A\n');
+  TestTo('A'#12,'A\f');
+  TestTo('A'#13,'A\r');
+  TestTo('A'#8'BC','A\bBC');
+  TestTo('A'#9'BC','A\tBC');
+  TestTo('A'#10'BC','A\nBC');
+  TestTo('A'#12'BC','A\fBC');
+  TestTo('A'#13'BC','A\rBC');
+  TestTo('\\','\\\\');
+  TestTo('//','//');
+  TestTo('//','\/\/',true);
+  TestTo('""','\"\"');
+  TestTo(#8#8,'\b\b');
+  TestTo(#9#9,'\t\t');
+  TestTo(#10#10,'\n\n');
+  TestTo(#12#12,'\f\f');
+  TestTo(#13#13,'\r\r');
+end;
+
+initialization
+  RegisterTest(TTestJSONString);
+  RegisterTest(TTestNull);
+  RegisterTest(TTestBoolean);
+  RegisterTest(TTestInteger);
+  RegisterTest(TTestInt64);
+  RegisterTest(TTestQWord);
+  RegisterTest(TTestFloat);
+  RegisterTest(TTestString);
+  RegisterTest(TTestArray);
+  RegisterTest(TTestObject);
+  RegisterTest(TTestJSONPath);
+  RegisterTest(TTestFactory);
+  RegisterTest(TTestIterator);
+end.
+

+ 633 - 0
compiler/packages/fcl-json/tests/testjsonparser.pp

@@ -0,0 +1,633 @@
+{
+    This file is part of the Free Component Library
+
+    JSON FPCUNit test for parser
+    Copyright (c) 2007 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit testjsonparser;
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,fpjson,
+  jsonscanner,jsonParser,testjsondata;
+
+Const
+  DefaultOpts = [joUTF8,joStrict];
+
+type
+
+  { TTestParser }
+
+  TTestParser = class(TTestJSON)
+  private
+    FOptions : TJSONOptions;
+    procedure CallNoHandlerStream;
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts);
+    procedure DoTestFloat(F: TJSONFloat); overload;
+    procedure DoTestFloat(F: TJSONFloat; S: String); overload;
+    procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
+    procedure DoTestString(S : String; AResult : String);
+    procedure DoTestString(S : String);
+    procedure DoTestArray(S: String; ACount: Integer; IgnoreJSON: Boolean=False);
+    Procedure DoTestClass(S : String; AClass : TJSONDataClass);
+    procedure CallNoHandler;
+    procedure DoTrailingCommaErrorArray;
+    procedure DoTrailingCommaErrorObject;
+  Protected
+    Procedure Setup; override;
+  published
+    procedure TestEmpty;
+    procedure TestNull;
+    procedure TestTrue;
+    procedure TestFalse;
+    procedure TestFloat;
+    procedure TestInteger;
+    procedure TestInt64;
+    procedure TestString;
+    procedure TestArray;
+    procedure TestObject;
+    procedure TestObjectError;
+    procedure TestTrailingComma;
+    procedure TestTrailingCommaErrorArray;
+    procedure TestTrailingCommaErrorObject;
+    procedure TestMixed;
+    Procedure TestComment;
+    procedure TestErrors;
+    Procedure TestClasses;
+    Procedure TestHandler;
+    Procedure TestNoHandlerError;
+    Procedure TestHandlerResult;
+    Procedure TestHandlerResultStream;
+  end;
+
+implementation
+
+procedure TTestParser.TestEmpty;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  
+begin
+  P:=TJSONParser.Create('',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J<>Nil) then
+      Fail('Empty returns Nil');
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestInteger;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('1',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of 1 fails');
+    TestJSONType(J,jtNumber);
+    TestAsInteger(J,1);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestInt64;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('123456789012345',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of 123456789012345 fails');
+    TestJSONType(J,jtNumber);
+    TestAsInt64(J,123456789012345);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestNull;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('null',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of null fails');
+    TestJSONType(J,jtNull);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestTrue;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('true',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of True fails');
+    TestJSONType(J,jtBoolean);
+    TestAsBoolean(J,True);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestFalse;
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('false',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of False fails');
+    TestJSONType(J,jtBoolean);
+    TestAsBoolean(J,False);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.TestFloat;
+
+
+begin
+  DoTestFloat(1.2);
+  DoTestFloat(-1.2);
+  DoTestFloat(0);
+  DoTestFloat(1.2e1);
+  DoTestFloat(-1.2e1);
+  DoTestFloat(0);
+  DoTestFloat(1.2,'1.2');
+  DoTestFloat(-1.2,'-1.2');
+  DoTestFloat(0,'0.0');
+end;
+
+procedure TTestParser.TestString;
+
+Const
+  // Glowing star in UTF8
+  GlowingStar = #$F0#$9F#$8C#$9F;
+
+begin
+  DoTestString('A string');
+  DoTestString('');
+  DoTestString('\"');
+  DoTestString('\u00f8','ø'); // this is ø
+  DoTestString('\u00f8\"','ø"'); // this is ø"
+//  Writeln(GlowingStar);
+  DoTestString('\ud83c\udf1f',GlowingStar);
+end;
+
+
+procedure TTestParser.TestArray;
+
+Var
+  S1,S2,S3 : String;
+
+begin
+  DoTestArray('[]',0);
+  DoTestArray('[null]',1);
+  DoTestArray('[true]',1);
+  DoTestArray('[false]',1);
+  DoTestArray('[1]',1);
+  DoTestArray('[1, 2]',2);
+  DoTestArray('[1, 2, 3]',3);
+  DoTestArray('[1234567890123456]',1);
+  DoTestArray('[1234567890123456, 2234567890123456]',2);
+  DoTestArray('[1234567890123456, 2234567890123456, 3234567890123456]',3);
+  Str(12/10,S1);
+  Delete(S1,1,1);
+  Str(34/10,S2);
+  Delete(S2,1,1);
+  Str(34/10,S3);
+  Delete(S3,1,1);
+  DoTestArray('['+S1+']',1,true);
+  DoTestArray('['+S1+', '+S2+']',2,true);
+  DoTestArray('['+S1+', '+S2+', '+S3+']',3,true);
+  DoTestArray('["A string"]',1);
+  DoTestArray('["A string", "Another string"]',2);
+  DoTestArray('["A string", "Another string", "Yet another string"]',3);
+  DoTestArray('[null, false]',2);
+  DoTestArray('[true, false]',2);
+  DoTestArray('[null, 1]',2);
+  DoTestArray('[1, "A string"]',2);
+  DoTestArray('[1, []]',2);
+  DoTestArray('[1, [1, 2]]',2);
+end;
+
+procedure TTestParser.TestTrailingComma;
+begin
+  FOptions:=[joIgnoreTrailingComma];
+  DoTestArray('[1, 2,]',2,True);
+  DoTestObject('{ "a" : 1, }',['a'],False);
+end;
+
+procedure TTestParser.TestTrailingCommaErrorArray;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
+end;
+
+procedure TTestParser.TestTrailingCommaErrorObject;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
+end;
+
+procedure TTestParser.DoTrailingCommaErrorArray;
+begin
+  DoTestArray('[1, 2,]',2,True);
+end;
+
+procedure TTestParser.DoTrailingCommaErrorObject;
+begin
+  DoTestObject('{ "a" : 1, }',['a'],False);
+end;
+
+procedure TTestParser.TestMixed;
+
+Const
+
+  SAddr ='{ "addressbook": { "name": "Mary Lebow", '+
+         '  "address": {'+
+         '      "street": "5 Main Street",'+LineEnding+
+         '        "city": "San Diego, CA",'+LineEnding+
+         '        "zip": 91912'+LineEnding+
+         '    },'+LineEnding+
+         '    "phoneNumbers": [  '+LineEnding+
+         '        "619 332-3452",'+LineEnding+
+         '        "664 223-4667"'+LineEnding+
+         '    ]'+LineEnding+
+         ' }'+LineEnding+
+         '}';
+
+begin
+  DoTestArray('[1, {}]',2);
+  DoTestArray('[1, { "a" : 1 }]',2);
+  DoTestArray('[1, { "a" : 1 }, 1]',3);
+  DoTestObject('{ "a" : [1, 2] }',['a']);
+  DoTestObject('{ "a" : [1, 2], "B" : { "c" : "d" } }',['a','B']);
+  DoTestObject(SAddr,['addressbook'],False);
+end;
+
+procedure TTestParser.TestComment;
+begin
+  FOptions:=[joComments];
+  DoTestArray('/* */ [1, {}]',2,True);
+  DoTestArray('//'+sLineBreak+'[1, { "a" : 1 }]',2,True);
+  DoTestArray('/* '+sLineBreak+' */ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',2,True);
+  DoTestArray('/* */ [1, {}]',2,True);
+  DoTestArray('[1, { "a" : 1 }]//'+sLineBreak,2,True);
+  DoTestArray('[1, {}]/* '+sLineBreak+' */ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*/ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*/ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*'+sLineBreak+'*/ ',2,True);
+  DoTestArray(' [1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/',2,True);
+end;
+
+procedure TTestParser.TestObject;
+begin
+  DoTestObject('{}',[]);
+  DoTestObject('{ "a" : 1 }',['a']);
+  DoTestObject('{ "a" : 1, "B" : "String" }',['a','B']);
+  DoTestObject('{ "a" : 1, "B" : {} }',['a','B']);
+  DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']);
+end;
+
+procedure TTestParser.TestObjectError;
+begin
+
+  DoTestError('{ "name" : value }',[joUTF8]);
+end;
+
+
+procedure TTestParser.DoTestObject(S: String; const ElNames: array of String;
+  DoJSONTest: Boolean);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  O : TJSONObject;
+  I : Integer;
+
+begin
+  J:=Nil;
+  P:=TJSONParser.Create(S,[joUTF8]);
+  Try
+    P.Options:=FOptions;
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of object "'+S+'" fails');
+    TestJSONType(J,jtObject);
+    TestItemCount(J,High(ElNames)-Low(ElNames)+1);
+    O:=TJSONObject(J);
+    For I:=Low(ElNames) to High(ElNames) do
+      AssertEquals(Format('Element %d name',[I-Low(Elnames)])
+                   ,ElNames[i], O.Names[I-Low(ElNames)]);
+    If DoJSONTest then
+      self.TestJSON(J,S);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+
+procedure TTestParser.DoTestArray(S : String; ACount : Integer; IgnoreJSON : Boolean = False);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  J:=Nil;
+  P:=TJSONParser.Create(S,[joComments]);
+  Try
+    P.Options:=FOptions;
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of array "'+S+'" fails');
+    TestJSONType(J,jtArray);
+    TestItemCount(J,ACount);
+    if not IgnoreJSON then
+      TestJSON(J,S);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.DoTestClass(S: String; AClass: TJSONDataClass);
+
+Var
+  P : TJSONParser;
+  D : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S,[joUTF8]);
+  try
+    D:=P.Parse;
+    try
+      AssertEquals('Correct class for '+S+' : ',AClass,D.ClassType);
+    finally
+      D.Free
+    end;
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TTestParser.TestErrors;
+
+begin
+
+  DoTestError('1Tru');
+  DoTestError('a');
+  DoTestError('"b');
+
+  DoTestError('b"');
+  DoTestError('{"a" : }');
+  DoTestError('{"a" : ""');
+  DoTestError('{"a : ""');
+
+  DoTestError('[1,]');
+  DoTestError('[,]');
+  DoTestError('[,,]');
+  DoTestError('[1,,]');
+
+end;
+
+procedure TTestParser.TestClasses;
+begin
+  SetMyInstanceTypes;
+  DoTestClass('null',TMyNull);
+  DoTestClass('true',TMyBoolean);
+  DoTestClass('1',TMyInteger);
+  DoTestClass('1.2',TMyFloat);
+  DoTestClass('123456789012345',TMyInt64);
+  DoTestClass('"tata"',TMyString);
+  DoTestClass('{}',TMyObject);
+  DoTestClass('[]',TMyArray);
+end;
+
+procedure TTestParser.CallNoHandler;
+
+begin
+  GetJSON('1',True).Free;
+end;
+
+procedure TTestParser.Setup;
+begin
+  inherited Setup;
+  FOptions:=[];
+end;
+
+procedure TTestParser.CallNoHandlerStream;
+
+Var
+  S : TStringStream;
+
+begin
+  S:=TstringStream.Create('1');
+  try
+    GetJSON(S,True).Free;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestParser.TestHandler;
+begin
+  AssertNotNull('Handler installed',GetJSONParserHandler);
+end;
+
+procedure TTestParser.TestNoHandlerError;
+
+Var
+  H : TJSONParserHandler;
+
+begin
+  H:=GetJSONParserHandler;
+  try
+    AssertSame('SetJSONParserHandler returns previous handler',H,SetJSONParserHandler(Nil));
+    AssertException('No handler raises exception',EJSON,@CallNoHandler);
+    AssertException('No handler raises exception',EJSON,@CallNoHandlerStream);
+  finally
+    SetJSONParserHandler(H);
+  end;
+end;
+
+procedure TTestParser.TestHandlerResult;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON('"123"');
+  try
+    AssertEquals('Have correct string','123',D.AsString);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TTestParser.TestHandlerResultStream;
+Var
+  D : TJSONData;
+  S : TStream;
+
+begin
+  S:=TStringStream.Create('"123"');
+  try
+    D:=GetJSON(S);
+    try
+      AssertEquals('Have correct string','123',D.AsString);
+    finally
+      D.Free;
+    end;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+  ParseOK : Boolean;
+  N : String;
+
+begin
+  ParseOK:=False;
+  P:=TJSONParser.Create(S,[joUTF8]);
+  P.OPtions:=Options;
+  J:=Nil;
+  Try
+    Try
+      Repeat
+        FreeAndNil(J);
+        J:=P.Parse;
+        ParseOK:=True;
+        If (J<>Nil) then
+          N:=J.ClassName;
+      Until (J=Nil)
+    Finally
+      FreeAndNil(J);
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but returned '+N);
+end;
+
+procedure TTestParser.DoTestString(S: String);
+
+begin
+  DoTestString(S,JSONStringToString(S));
+end;
+
+procedure TTestParser.DoTestString(S: String; AResult : String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create('"'+S+'"',[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of string "'+S+'" fails');
+    TestJSONType(J,jtString);
+    TestAsString(J,aResult);
+    if Pos('\u',S)=0 then
+      TestJSON(J,'"'+S+'"');
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+procedure TTestParser.DoTestFloat(F : TJSONFloat);
+
+Var
+  S : String;
+
+begin
+  Str(F,S);
+  DoTestFloat(F,S);
+end;
+
+procedure TTestParser.DoTestFloat(F : TJSONFloat; S : String);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S,[joUTF8]);
+  Try
+    J:=P.Parse;
+    If (J=Nil) then
+      Fail('Parse of float '+S+' fails');
+    TestJSONType(J,jtNumber);
+    TestAsFloat(J,F);
+  Finally
+    FreeAndNil(J);
+    FreeAndNil(P);
+  end;
+end;
+
+
+initialization
+  RegisterTest(TTestParser);
+end.
+

+ 810 - 0
compiler/packages/fcl-json/tests/testjsonreader.pp

@@ -0,0 +1,810 @@
+unit testjsonreader;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,fpjson,jsonscanner,jsonreader, testjsondata;
+
+Const
+  DefaultOpts = [joUTF8,joStrict];
+
+type
+  
+  { TMyJSONReader }
+
+  TMyJSONReader = Class(TBaseJSONReader)
+  Private
+    FList : TStrings;
+    function GetList: TStrings;
+    procedure Push(const aType : String; const AValue: String='');
+  protected
+    procedure BooleanValue(const AValue: Boolean); override;
+    procedure EndArray; override;
+    procedure EndObject; override;
+    procedure FloatValue(const AValue: Double); override;
+    procedure Int64Value(const AValue: int64); override;
+    procedure IntegerValue(const AValue: integer); override;
+    procedure KeyValue(const AKey: TJSONStringType); override;
+    procedure NullValue; override;
+    procedure NumberValue(const AValue: TJSONStringType); override;
+    procedure QWordValue(const AValue: QWord); override;
+    procedure StartArray; override;
+    procedure StartObject; override;
+    procedure StringValue(const AValue: TJSONStringType); override;
+  Public
+    destructor Destroy; override;
+    Property List : TStrings Read GetList;
+  end;
+
+  { TTestParser }
+
+  { TTestReader }
+
+  TBaseTestReader = class(TTestJSON)
+  private
+    FOptions : TJSONOptions;
+    procedure CallNoHandlerStream;
+    procedure DoTestFloat(F: TJSONFloat); overload;
+    procedure DoTestFloat(F: TJSONFloat; S: String); overload;
+    procedure DoTestString(S: String; AValue: String='');
+    procedure DoTrailingCommaErrorArray;
+    procedure DoTrailingCommaErrorObject;
+  Protected
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); virtual; abstract;
+    Procedure TestRead(aJSON : String; AResult : Array of string); virtual; abstract;
+  published
+    procedure TestEmpty;
+    procedure TestNull;
+    procedure TestTrue;
+    procedure TestFalse;
+    procedure TestFloat;
+    procedure TestInteger;
+    procedure TestInt64;
+    procedure TestString;
+    procedure TestArray;
+    procedure TestObject;
+    procedure TestObjectError;
+    procedure TestTrailingComma;
+    procedure TestTrailingCommaErrorArray;
+    procedure TestTrailingCommaErrorObject;
+    procedure TestMixed;
+    Procedure TestComment;
+    procedure TestErrors;
+  end;
+
+  TTestReader = Class(TBaseTestReader)
+  Private
+    FReader: TMyJSONReader;
+  Protected
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TMyJSONReader Read FReader;
+  end;
+
+  { TJSONConsumer }
+
+  TJSONConsumer = Class(TInterfacedObject,IJSONConsumer)
+  Private
+    FList : TStrings;
+    procedure Push(const aType : String; const AValue: String='');
+  protected
+    procedure BooleanValue(const AValue: Boolean);
+    procedure EndArray;
+    procedure EndObject;
+    procedure FloatValue(const AValue: Double);
+    procedure Int64Value(const AValue: int64);
+    procedure IntegerValue(const AValue: integer);
+    procedure KeyName(const AKey: TJSONStringType);
+    procedure NullValue;
+    procedure NumberValue(const AValue: TJSONStringType);
+    procedure QWordValue(const AValue: QWord);
+    procedure StartArray;
+    procedure StartObject;
+    procedure StringValue(const AValue: TJSONStringType);
+  Public
+    Constructor Create(AList : TStrings);
+    Property List : TStrings Read FList;
+  end;
+
+  { TTestJSONConsumerReader }
+
+  TTestJSONConsumerReader = Class(TBaseTestReader)
+  Private
+    FList : TStrings;
+    FReader: TJSONConsumerReader;
+  Protected
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TJSONConsumerReader Read FReader;
+  end;
+
+  { TTestJSONEventReader }
+
+  TTestJSONEventReader = Class(TBaseTestReader)
+  Private
+    FList : TStrings;
+    FReader: TJSONEventReader;
+  Protected
+    procedure Push(const aType : String; const AValue: String='');
+    procedure BooleanValue(Sender: TObject; const AValue: Boolean);
+    procedure EndArray(Sender: TObject);
+    procedure EndObject(Sender: TObject);
+    procedure FloatValue(Sender: TObject; const AValue: Double);
+    procedure Int64Value(Sender: TObject; const AValue: int64);
+    procedure IntegerValue(Sender: TObject; const AValue: integer);
+    procedure KeyValue(Sender: TObject; const AKey: TJSONStringType);
+    procedure NullValue(Sender: TObject);
+    procedure NumberValue(Sender: TObject; const AValue: TJSONStringType);
+    procedure QWordValue(Sender: TObject; const AValue: QWord);
+    procedure StartArray(Sender: TObject);
+    procedure StartObject(Sender: TObject);
+    procedure StringValue(Sender: TObject; const AValue: TJSONStringType);
+    Procedure HookupEvents(AReader: TJSONEventReader);
+    Procedure Teardown; override;
+  Public
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts); override;
+    Procedure TestRead(aJSON : String; AResult : Array of string); override;
+    Property Reader : TJSONEventReader Read FReader;
+  end;
+
+
+implementation
+
+
+{ TMyJSONReader }
+
+function TMyJSONReader.GetList: TStrings;
+begin
+  If FList=Nil then
+    FList:=TStringList.Create;
+  Result:=Flist;
+end;
+
+procedure TMyJSONReader.Push(const aType : String; const AValue : String = '');
+
+begin
+  if AValue<>'' then
+    List.Add(aType+':'+AValue)
+  else
+    List.Add(aType);
+end;
+
+procedure TMyJSONReader.BooleanValue(const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TMyJSONReader.EndArray;
+begin
+  Push('ea');
+end;
+
+procedure TMyJSONReader.EndObject;
+begin
+  Push('eo');
+end;
+
+procedure TMyJSONReader.FloatValue(const AValue: Double);
+begin
+  List.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TMyJSONReader.Int64Value(const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TMyJSONReader.IntegerValue(const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TMyJSONReader.KeyValue(const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TMyJSONReader.NullValue;
+begin
+  Push('null');
+end;
+
+procedure TMyJSONReader.NumberValue(const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TMyJSONReader.QWordValue(const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TMyJSONReader.StartArray;
+begin
+  Push('sa');
+end;
+
+procedure TMyJSONReader.StartObject;
+begin
+  Push('so');
+end;
+
+procedure TMyJSONReader.StringValue(const AValue: TJSONStringType);
+begin
+  List.Add('string:'+AValue)
+end;
+
+destructor TMyJSONReader.Destroy;
+begin
+  FreeAndNil(Flist);
+  inherited Destroy;
+end;
+
+procedure TBaseTestReader.TestEmpty;
+
+begin
+  TestRead('',[]);
+end;
+
+procedure TBaseTestReader.TestInteger;
+
+
+begin
+  TestRead('1',['number:1','integer:1']);
+end;
+
+procedure TBaseTestReader.TestInt64;
+
+begin
+  TestRead('123456789012345',['number:123456789012345','int64:123456789012345']);
+end;
+
+procedure TBaseTestReader.TestNull;
+
+
+begin
+  TestRead('null',['null']);
+end;
+
+procedure TBaseTestReader.TestTrue;
+
+begin
+  TestRead('true',['boolean:'+BoolToStr(true)]);
+end;
+
+procedure TBaseTestReader.TestFalse;
+
+begin
+  TestRead('false',['boolean:'+BoolToStr(false)]);
+end;
+
+procedure TBaseTestReader.TestFloat;
+
+
+begin
+  DoTestFloat(1.2);
+  DoTestFloat(-1.2);
+  DoTestFloat(0);
+  DoTestFloat(1.2e1);
+  DoTestFloat(-1.2e1);
+  DoTestFloat(0);
+  DoTestFloat(1.2,'1.2');
+  DoTestFloat(-1.2,'-1.2');
+  DoTestFloat(0,'0.0');
+end;
+
+procedure TBaseTestReader.TestString;
+
+begin
+  DoTestString('A string');
+  DoTestString('');
+  DoTestString('\"','"');
+end;
+
+
+procedure TBaseTestReader.TestArray;
+
+Var
+  S1,S2,S3 : String;
+
+begin
+  TestRead('[]',['sa','ea']);
+  TestRead('[null]',['sa','null','ea']);
+  TestRead('[true]',['sa','boolean:'+BoolToStr(true),'ea']);
+  TestRead('[false]',['sa','boolean:'+BoolToStr(false),'ea']);
+  TestRead('[1]',['sa','number:1','integer:1','ea']);
+  TestRead('[1, 2]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+  TestRead('[1, 2, 3]',['sa','number:1','integer:1','number:2','integer:2','number:3','integer:3','ea']);
+  TestRead('[1234567890123456]',['sa','number:1234567890123456','int64:1234567890123456','ea']);
+  TestRead('[1234567890123456, 2234567890123456]',
+    ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456','ea']);
+  TestRead('[1234567890123456, 2234567890123456, 3234567890123456]',
+    ['sa','number:1234567890123456','int64:1234567890123456','number:2234567890123456','int64:2234567890123456',
+     'number:3234567890123456','int64:3234567890123456','ea']);
+  Str(12/10,S1);
+  Delete(S1,1,1);
+  Str(34/10,S2);
+  Delete(S2,1,1);
+  Str(34/10,S3);
+  Delete(S3,1,1);
+  TestRead('['+S1+']',['sa','number:'+s1,'float:'+formatfloat('##.##',12/10),'ea']);
+  {
+  TestRead('['+S1+', '+S2+']',2,true);
+  TestRead('['+S1+', '+S2+', '+S3+']',3,true);
+  TestRead('["A string"]',1);
+  TestRead('["A string", "Another string"]',2);
+  TestRead('["A string", "Another string", "Yet another string"]',3);
+  TestRead('[null, false]',2);
+  TestRead('[true, false]',2);
+  TestRead('[null, 1]',2);
+  TestRead('[1, "A string"]',2);
+  TestRead('[1, []]',2);
+  TestRead('[1, [1, 2]]',2);}
+end;
+
+procedure TBaseTestReader.TestTrailingComma;
+begin
+  FOptions:=[joIgnoreTrailingComma];
+  TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+  TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
+end;
+
+procedure TBaseTestReader.TestTrailingCommaErrorArray;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
+end;
+
+procedure TBaseTestReader.TestTrailingCommaErrorObject;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
+end;
+
+procedure TBaseTestReader.DoTrailingCommaErrorArray;
+begin
+  TestRead('[1, 2, ]',['sa','number:1','integer:1','number:2','integer:2','ea']);
+end;
+
+procedure TBaseTestReader.DoTrailingCommaErrorObject;
+begin
+  TestRead('{ "a" : 1, }',['so','key:a', 'number:1','integer:1','eo']);
+end;
+
+
+procedure TBaseTestReader.TestMixed;
+
+begin
+  TestRead('[1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, { "a" : 1 }]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','ea']);
+  TestRead('[1, { "a" : 1 }, 1]',['sa','number:1','integer:1','so','key:a','number:1','integer:1','eo','number:1','integer:1','ea']);
+  TestRead('{ "a" : [1, 2] }',['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','eo']);
+  TestRead('{ "a" : [1, 2], "B" : { "c" : "d" } }',
+    ['so','key:a','sa','number:1','integer:1','number:2','integer:2','ea','key:B','so','key:c','string:d','eo','eo']);
+end;
+
+procedure TBaseTestReader.TestComment;
+begin
+  FOptions:=[joComments];
+  TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('//'+sLineBreak+' [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/* '+sLineBreak+' */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('/* */ [1, {}]',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]//',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+' */',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+' */ ',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/* '+sLineBreak+'*'+sLineBreak+'*/ ',['sa','number:1','integer:1','so','eo','ea']);
+  TestRead('[1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/ ',['sa','number:1','integer:1','so','eo','ea']);
+end;
+
+procedure TBaseTestReader.TestObject;
+begin
+  TestRead('{}',['so','eo']);
+  TestRead('{ "a" : 1 }',['so','key:a','number:1','integer:1','eo']);
+  TestRead('{ "a" : 1, "B" : "String" }',['so','key:a','number:1','integer:1','key:B','string:String','eo']);
+  TestRead('{ "a" : 1, "B" : {} }',['so','key:a','number:1','integer:1','key:B','so','eo','eo']);
+  TestRead('{ "a" : 1, "B" : { "c" : "d" } }',['so','key:a','number:1','integer:1','key:B','so','key:c','string:d','eo','eo']);
+end;
+
+procedure TBaseTestReader.TestObjectError;
+begin
+  DoTestError('{ "name" : value }',[joUTF8]);
+end;
+
+
+procedure TBaseTestReader.TestErrors;
+
+begin
+
+  DoTestError('a');
+  DoTestError('"b');
+  DoTestError('1Tru');
+
+  DoTestError('b"');
+  DoTestError('{"a" : }');
+  DoTestError('{"a" : ""');
+  DoTestError('{"a : ""');
+
+  DoTestError('[1,]');
+  DoTestError('[,]');
+  DoTestError('[,,]');
+  DoTestError('[1,,]');
+
+end;
+
+
+procedure TBaseTestReader.CallNoHandlerStream;
+
+Var
+  S : TStringStream;
+
+begin
+  S:=TstringStream.Create('1');
+  try
+    GetJSON(S,True).Free;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TBaseTestReader.DoTestString(S: String; AValue : String = '');
+
+begin
+  if AValue='' then
+    AValue:=S;
+  TestRead('"'+S+'"',['string:'+AValue]);
+end;
+
+procedure TBaseTestReader.DoTestFloat(F : TJSONFloat);
+
+Var
+  S : String;
+
+begin
+  Str(F,S);
+  DoTestFloat(F,S);
+end;
+
+procedure TBaseTestReader.DoTestFloat(F : TJSONFloat; S : String);
+
+begin
+  TestRead(S,['number:'+trim(S),'float:'+formatfloat('##.##',F)]);
+end;
+
+procedure TTestReader.Teardown;
+begin
+  FreeAndNil(FReader);
+  inherited Teardown;
+end;
+
+procedure TTestReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FReader:=TMyJSONReader.Create(aJSON,Foptions);
+  TMyJSONReader(FReader).DoExecute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FReader.List.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FReader.List[I]);
+end;
+
+procedure TTestReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
+
+Var
+  P:TMyJSONReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  P:=TMyJSONReader.Create(S,FOptions);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.DoExecute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+
+{ TJSONConsumer }
+
+procedure TJSONConsumer.Push(const aType : String; const AValue : String = '');
+
+begin
+  if AValue<>'' then
+    List.Add(aType+':'+AValue)
+  else
+    List.Add(aType);
+end;
+
+procedure TJSONConsumer.BooleanValue(const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TJSONConsumer.EndArray;
+begin
+  Push('ea');
+end;
+
+procedure TJSONConsumer.EndObject;
+begin
+  Push('eo');
+end;
+
+procedure TJSONConsumer.FloatValue(const AValue: Double);
+begin
+  List.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TJSONConsumer.Int64Value(const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TJSONConsumer.IntegerValue(const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TJSONConsumer.KeyName(const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TJSONConsumer.NullValue;
+begin
+  Push('null');
+end;
+
+procedure TJSONConsumer.NumberValue(const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TJSONConsumer.QWordValue(const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TJSONConsumer.StartArray;
+begin
+  Push('sa');
+end;
+
+procedure TJSONConsumer.StartObject;
+begin
+  Push('so');
+end;
+
+procedure TJSONConsumer.StringValue(const AValue: TJSONStringType);
+begin
+  List.Add('string:'+AValue)
+end;
+
+constructor TJSONConsumer.Create(AList: TStrings);
+begin
+  FList:=AList;
+end;
+
+procedure TTestJSONConsumerReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  FReader:=TJSONConsumerReader.Create(aJSON,Foptions);
+  FReader.Consumer:=TJSONConsumer.Create(FList);
+  TJSONConsumerReader(FReader).Execute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
+end;
+
+procedure TTestJSONConsumerReader.Teardown;
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(FList);
+  inherited Teardown;
+end;
+
+procedure TTestJSONConsumerReader.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
+
+Var
+  P:TJSONConsumerReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  P:=TJSONConsumerReader.Create(S,Options);
+  P.Consumer:=TJSONConsumer.Create(FList);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.Execute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+{ TTestJSONEventReader }
+
+procedure TTestJSONEventReader.Teardown;
+begin
+  FreeAndNil(Freader);
+  FreeAndNil(Flist);
+  inherited Teardown;
+end;
+
+procedure TTestJSONEventReader.DoTestError(S: String; Options: TJSONOptions);
+
+Var
+  P:TJSONEventReader;
+  ParseOK : Boolean;
+
+begin
+  ParseOK:=False;
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  P:=TJSONEventReader.Create(S,Options);
+  HookupEvents(P);
+  P.OPtions:=Options;
+  Try
+    Try
+      P.Execute;
+      ParseOk:=True;
+    Finally
+      FreeAndNil(P);
+    end;
+  except
+    ParseOk:=False;
+  end;
+  If ParseOK then
+    Fail('Parse of JSON string "'+S+'" should fail, but succeeded');
+end;
+
+procedure TTestJSONEventReader.TestRead(aJSON: String; AResult: array of string);
+
+Var
+  I : Integer;
+
+begin
+  FreeAndNil(FReader);
+  FreeAndNil(Flist);
+  FList:=TStringList.Create;
+  FReader:=TJSONEventReader.Create(aJSON,Foptions);
+  HookupEvents(FReader);
+  FReader.Execute;
+  AssertEquals(aJSON+': Number of events',Length(AResult),FList.Count);
+  For I:=0 to Length(AResult)-1 do
+    AssertEquals(aJSON+': Event number '+IntToStr(I),AResult[i],FList[I]);
+end;
+
+procedure TTestJSONEventReader.Push(const aType: String; const AValue: String);
+begin
+  if AValue<>'' then
+    FList.Add(aType+':'+AValue)
+  else
+    FList.Add(aType);
+end;
+
+procedure TTestJSONEventReader.BooleanValue(Sender: TObject; const AValue: Boolean);
+begin
+  Push('boolean',BoolToStr(AValue));
+end;
+
+procedure TTestJSONEventReader.EndArray(Sender: TObject);
+begin
+  Push('ea');
+end;
+
+procedure TTestJSONEventReader.EndObject(Sender: TObject);
+begin
+  Push('eo');
+end;
+
+procedure TTestJSONEventReader.FloatValue(Sender: TObject; const AValue: Double);
+begin
+  FList.Add('float:'+formatFloat('##.##',AVAlue));
+end;
+
+procedure TTestJSONEventReader.Int64Value(Sender: TObject; const AValue: int64);
+begin
+  Push('int64',IntToStr(aValue));
+end;
+
+procedure TTestJSONEventReader.IntegerValue(Sender: TObject; const AValue: integer);
+begin
+  Push('integer',IntToStr(aValue));
+end;
+
+procedure TTestJSONEventReader.KeyValue(Sender: TObject; const AKey: TJSONStringType);
+begin
+  Push('key',akey);
+end;
+
+procedure TTestJSONEventReader.NullValue(Sender: TObject);
+begin
+  Push('null');
+end;
+
+procedure TTestJSONEventReader.NumberValue(Sender: TObject; const AValue: TJSONStringType);
+begin
+  Push('number',aValue);
+end;
+
+procedure TTestJSONEventReader.QWordValue(Sender: TObject; const AValue: QWord);
+begin
+  Push('qword',IntToStr(AValue));
+end;
+
+procedure TTestJSONEventReader.StartArray(Sender: TObject);
+begin
+  Push('sa');
+end;
+
+procedure TTestJSONEventReader.StartObject(Sender: TObject);
+begin
+  Push('so');
+end;
+
+procedure TTestJSONEventReader.StringValue(Sender: TObject; const AValue: TJSONStringType);
+begin
+  FList.Add('string:'+AValue)
+end;
+
+procedure TTestJSONEventReader.HookupEvents(AReader: TJSONEventReader);
+begin
+  With Areader do
+    begin
+    OnNullValue:=@NullValue;
+    OnBooleanValue:=@BooleanValue;
+    OnNumberValue:=@NumberValue;
+    OnFloatValue:=@FloatValue;
+    OnIntegerValue:=@IntegerValue;
+    OnInt64Value:=@Int64Value;
+    OnQWordValue:=@QWordValue;
+    OnStringValue:=@StringValue;
+    OnKeyName:=@KeyValue;
+    OnStartObject:=@StartObject;
+    OnEndObject:=@EndObject;
+    OnStartArray:=@StartArray;
+    OnEndArray:=@EndArray;
+    end;
+end;
+
+initialization
+  RegisterTests([TTestReader,TTestJSONConsumerReader,TTestJSONEventReader]);
+
+end.
+

+ 1889 - 0
compiler/packages/fcl-json/tests/testjsonrtti.pp

@@ -0,0 +1,1889 @@
+unit testjsonrtti;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, typinfo, fpjson,
+  dateutils, testcomps, testjsondata, fpjsonrtti;
+
+type
+
+  { TTestJSONStreamer }
+
+  TTestJSONStreamer = class(TTestJSON)
+  private
+    FRJ : TJSONStreamer;
+    FSR : TJSONObject;
+    FToFree : TObject;
+    FCalled : Boolean;
+    procedure DoStreamProperty1(Sender: TObject; AObject: TObject; Info: PPropInfo; var Res: TJSONData);
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override;
+    Procedure AssertEquals(AMessage : String; Expected,Actual : TJSONType); overload;
+    Procedure AssertPropCount(ACount : Integer);
+    Function  AssertProperty(APropName : String; AType : TJSONType) : TJSONData;
+    Procedure AssertProp(APropName : String; AValue : Boolean);
+    Procedure AssertProp(APropName : String; AValue : Integer);
+    procedure AssertProp(APropName : String; AValue: String);
+    procedure AssertProp(APropName : String; AValue: TJSONFloat);
+    procedure AssertProp(APropName : String; AValue : Array of String);
+    procedure AssertProp(APropName : String; AValue : Array of Integer);
+    function CreateVariantComp : TVariantComponent;
+    procedure AssertNullProp(APropName : String);
+    Function AssertObjectProp(APropName : String) : TJSONObject;
+    Function AssertArrayProp(APropName : String) : TJSONArray;
+    Function StreamObject(AObject : TObject) : TJSONObject;
+    Property RJ : TJSONStreamer read FRJ;
+    Property SR : TJSONObject Read FSR Write FSR;
+  published
+    procedure TestNil;
+    procedure TestEmpty;
+    procedure TestEmptyComponent;
+    procedure TestWriteBoolean;
+    procedure TestWriteInteger;
+    procedure TestWriteString;
+    procedure TestWriteFloat;
+    procedure TestWriteFloat2;
+    procedure TestWriteFloat3;
+    procedure TestWriteFloat4;
+    procedure TestWriteFloat5;
+    procedure TestEnum1;
+    procedure TestEnum2;
+    Procedure TestSet1;
+    Procedure TestSet2;
+    Procedure TestSet3;
+    Procedure TestSet4;
+    Procedure TestObjectNil;
+    Procedure TestComponentProp1;
+    Procedure TestComponentProp2;
+    Procedure TestCollectionProp1;
+    Procedure TestCollectionProp2;
+    Procedure TestPersistentProp1;
+    Procedure TestStringsProp1;
+    Procedure TestStringsProp2;
+    procedure TestStringsProp3;
+    procedure TestStringsProp4;
+    procedure TestStringsArray;
+    procedure TestStringsObject;
+    procedure TestStringsStream1;
+    procedure TestStringsStream2;
+    procedure TestStringsStream3;
+    procedure TestStringsStream4;
+    procedure TestStringsStream5;
+    procedure TestCollectionStream;
+    procedure TestCollectionStream2;
+    procedure TestOnStreamProperty;
+    Procedure TestDateTimeProp;
+    Procedure TestDateTimePropDefaultString;
+    Procedure TestDateTimePropDefaultStringTime;
+    Procedure TestDateTimeProp2;
+    Procedure TestDateTimeProp3;
+    procedure TestDateTimeProp4;
+    procedure TestDateTimeProp5;
+    procedure TestDateTimeProp6;
+    procedure TestDateTimeProp7;
+    Procedure TestVariantShortint;
+    Procedure TestVariantbyte;
+    Procedure TestVariantword;
+    Procedure TestVariantsmallint;
+    Procedure TestVariantinteger;
+    Procedure TestVariantlongword;
+    Procedure TestVariantint64;
+    Procedure TestVariantqword;
+    Procedure TestVariantsingle;
+    Procedure TestVariantdouble;
+    Procedure TestVariantCurrency;
+    Procedure TestVariantString;
+    Procedure TestVariantolestr;
+    Procedure TestVariantboolean;
+    Procedure TestVariantDate;
+    procedure TestVariantDate2;
+    Procedure TestVariantArray;
+    Procedure TestMultipleProps;
+    Procedure TestObjectToJSONString;
+    Procedure TestStringsToJSONString;
+    Procedure TestCollectionToJSONString;
+    procedure TestTListToJSONString;
+    Procedure TestChildren;
+    Procedure TestChildren2;
+    Procedure TestLowercase;
+  end;
+
+  { TTestJSONDeStreamer }
+
+  TTestJSONDeStreamer = class(TTestJSON)
+  private
+    FDS : TJSONDeStreamer;
+    FJD : TJSONData;
+    FToFree : TObject;
+    procedure DeStream(JSON: TJSONStringType; AObject: TObject);
+    procedure DeStream(JSON: TJSONObject; AObject: TObject);
+    procedure DoDateTimeFormat;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure AssertVarType(Msg : String; AVarType : TVarType; Const Variant : Variant);
+    Property DS : TJSONDeStreamer Read FDS;
+    Property JD : TJSONData Read FJD Write FJD;
+    Property Tofree : TObject Read FToFree Write FToFree;
+  published
+    Procedure TestVariantInteger;
+    Procedure TestVariantFloat;
+    Procedure TestVariantInt64;
+    Procedure TestVariantBoolean;
+    Procedure TestVariantNull;
+    Procedure TestVariantString;
+    Procedure TestVariantArray;
+    procedure TestEmpty;
+    procedure TestBoolean;
+    procedure TestInteger;
+    procedure TestIntegerCaseInsensitive;
+    procedure TestIntegerCaseSensitive;
+    procedure TestString;
+    procedure TestFloat;
+    procedure TestFloat2;
+    procedure TestFloat3;
+    procedure TestFloat4;
+    procedure TestFloat5;
+    procedure TestDateTime;
+    procedure TestDateTimeFormat;
+    procedure TestEnum1;
+    procedure TestEnum2;
+    Procedure TestSet1;
+    Procedure TestSet2;
+    Procedure TestSet3;
+    Procedure TestSet4;
+    Procedure TestVariantProp;
+    procedure TestCollection;
+    procedure TestCollection2;
+    procedure TestCollection3;
+    procedure TestCollection4;
+    procedure TestCollection5;
+    procedure TestCollection6;
+    procedure TestCollectionProp;
+    procedure TestCollectionProp2;
+    procedure TestStrings;
+    procedure TestStrings2;
+    procedure TestStrings3;
+  end;
+
+implementation
+
+uses variants;
+
+{ TTestJSONDeStreamer }
+
+procedure TTestJSONDeStreamer.SetUp;
+begin
+  inherited SetUp;
+  FDS:=TJSONDeStreamer.Create(Nil)
+end;
+
+procedure TTestJSONDeStreamer.TearDown;
+begin
+  FreeAndNil(FDS);
+  FreeAndNil(FJD);
+  FreeAndNil(FToFree);
+  inherited TearDown;
+end;
+
+procedure TTestJSONDeStreamer.AssertVarType(Msg: String; AVarType: TVarType;
+  const Variant: Variant);
+begin
+  AssertEquals(Msg,VarTypeAsText(AVarType),VarTypeAsText(VarType(Variant)));
+end;
+
+procedure TTestJSONDeStreamer.TestVariantInteger;
+
+Var
+  V : Variant;
+
+begin
+  JD:=TJSOnIntegerNumber.Create(12);
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('Integer data',varInteger,V);
+  AssertEquals('Integer value',12,V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantFloat;
+Var
+  V : Variant;
+
+begin
+  JD:=TJSOnFloatNumber.Create(1.2);
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('Double data',varDouble,V);
+  AssertEquals('Float value',1.2,V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantInt64;
+Var
+  V : Variant;
+
+begin
+  JD:=TJSONInt64Number.Create(123);
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('Int64 data',varInt64,V);
+  AssertEquals('Int64 value',123,V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantBoolean;
+Var
+  V : Variant;
+
+begin
+  JD:=TJSONBoolean.Create(True);
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('Boolean data',varBoolean,V);
+  AssertEquals('Boolean value',True,V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantNull;
+Var
+  V : Variant;
+
+begin
+  JD:=TJSONNull.Create();
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('Null data',varNull,V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantString;
+Var
+  V : Variant;
+
+begin
+  JD:=TJSONString.Create('A string');
+  V:=DS.JSONToVariant(JD);
+  AssertVarType('String data',varOleStr,V);
+  AssertEquals('String data','A string',V);
+end;
+
+procedure TTestJSONDeStreamer.TestVariantArray;
+Var
+  V : Variant;
+begin
+  JD:=TJSONArray.Create([1,2,3]);
+  V:=DS.JSONToVariant(JD);
+  AssertEQuals('Variant is array',true,VarIsArray(V));
+  AssertEquals('Lower bound is zero ',0,VarArrayLowBound(V,1));
+  AssertEquals('Higher bound is count-1 ',2,VarArrayHighBound(V,1));
+  AssertEquals('Element 0 value correct ',1,V[0]);
+  AssertEquals('Element 1 value correct ',2,V[1]);
+  AssertEquals('Element 2 value correct ',3,V[2]);
+end;
+
+procedure TTestJSONDeStreamer.TestEmpty;
+begin
+  FTofree:=TComponent.Create(Nil);
+  DS.JSONToObject('{}',FTofree);
+  AssertEquals('Empty name','',TComponent(FToFree).Name);
+  AssertEquals('Empty Tag',0,TComponent(FToFree).Tag);
+end;
+
+procedure TTestJSONDeStreamer.DeStream(JSON : TJSONStringType; AObject : TObject);
+
+begin
+  FToFree:=AObject;
+  DS.JSONToObject(JSON,FTofree);
+end;
+
+procedure TTestJSONDeStreamer.DeStream(JSON: TJSONObject; AObject: TObject);
+begin
+  FToFree:=AObject;
+  JD:=JSON;
+  DS.JSONToObject(JSON,FTofree);
+end;
+
+procedure TTestJSONDeStreamer.TestBoolean;
+
+Var
+  B : TBooleanComponent;
+
+begin
+  B:=TBooleanComponent.Create(Nil);
+  DeStream('{ "BooleanProp" : true }',B);
+  AssertEquals('Correct boolean value',true,B.BooleanProp);
+end;
+
+procedure TTestJSONDeStreamer.TestInteger;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  B:=TIntegerComponent.Create(Nil);
+  DeStream('{ "IntProp" : 22 }',B);
+  AssertEquals('Correct integer value',22,B.IntProp);
+end;
+
+procedure TTestJSONDeStreamer.TestIntegerCaseInsensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options+[jdoCaseInsensitive];
+  B:=TIntegerComponent.Create(Nil);
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value',22,B.IntProp);
+end;
+
+procedure TTestJSONDeStreamer.TestIntegerCaseSensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options;
+  B:=TIntegerComponent.Create(Nil);
+  B.IntProp:=0;
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value not reas',0,B.IntProp);
+end;
+
+procedure TTestJSONDeStreamer.TestString;
+
+Var
+  B : TStringComponent;
+
+begin
+  B:=TStringComponent.Create(Nil);
+  DeStream('{ "StringProp" : "A nice string"}',B);
+  AssertEquals('Correct string value','A nice string',B.StringProp);
+end;
+
+procedure TTestJSONDeStreamer.TestFloat;
+
+Var
+  B : TSingleComponent;
+
+begin
+  B:=TSingleComponent.Create(Nil);
+  DeStream('{ "SingleProp" : 2.34 }',B);
+  AssertEquals('Correct single value',2.34,B.SingleProp);
+end;
+
+procedure TTestJSONDeStreamer.TestFloat2;
+
+Var
+  B : TDoubleComponent;
+
+begin
+  B:=TDoubleComponent.Create(Nil);
+  DeStream('{ "DoubleProp" : 3.45 }',B);
+  AssertEquals('Correct Double value',3.45,B.DoubleProp);
+end;
+
+procedure TTestJSONDeStreamer.TestFloat3;
+Var
+  B : TExtendedComponent;
+
+begin
+  B:=TExtendedComponent.Create(Nil);
+  DeStream('{ "ExtendedProp" : 4.56 }',B);
+  AssertEquals('Correct extended value',4.56,B.ExtendedProp);
+end;
+
+procedure TTestJSONDeStreamer.TestFloat4;
+
+Var
+  B : TCompComponent;
+
+begin
+  B:=TCompComponent.Create(Nil);
+  DeStream('{ "CompProp" : 5.67 }',B);
+  AssertEquals('Correct comp value',round(5.67),B.CompProp);
+end;
+
+procedure TTestJSONDeStreamer.TestFloat5;
+Var
+  B : TCurrencyComponent;
+
+begin
+  B:=TCurrencyComponent.Create(Nil);
+  DeStream('{ "CurrencyProp" : 5.67 }',B);
+  AssertEquals('Correct string value',5.67,B.CurrencyProp);
+end;
+
+procedure TTestJSONDeStreamer.TestDateTime;
+
+Var
+  E : TDateTimeComponent;
+  D : TDateTime;
+
+begin
+  E:=TDateTimeComponent.Create(Nil);
+  D:= RecodeMillisecond(Now,0);
+  DeStream('{"DateTimeProp" : "'+FormatDateTime(RFC3339DateTimeFormat,D)+'"}',E);
+  AssertEquals('Correct value',D,E.DateTimeProp);
+end;
+
+procedure TTestJSONDeStreamer.DoDateTimeFormat;
+
+begin
+  DeStream('{"DateTimeProp" : "'+DateTimeToStr(RecodeMillisecond(Now,0))+'"}',FToFree);
+end;
+
+procedure TTestJSONDeStreamer.TestDateTimeFormat;
+
+Const
+  ISO8601 = 'yyyymmdd"T"hhnnss';
+
+Var
+  E : TDateTimeComponent;
+  D : TDateTime;
+
+begin
+  E:=TDateTimeComponent.Create(Nil);
+  D:=RecodeMillisecond(Now,0);
+  DS.DateTimeFormat:=ISO8601;
+  DeStream('{"DateTimeProp" : "'+FormatDateTime(Iso8601,D)+'"}',E);
+  AssertEquals('Correct value',D,E.DateTimeProp);
+  AssertException('Error if  string does not correspond to specified format',EConvertError,@DoDateTimeFormat);
+end;
+
+procedure TTestJSONDeStreamer.TestEnum1;
+
+Var
+  E : TEnumcomponent;
+
+begin
+  E:=TEnumComponent.Create(Nil);
+  DeStream('{ "Dice" : 2 }',E);
+  AssertEquals('Correct value',2,Ord(E.Dice));
+end;
+
+procedure TTestJSONDeStreamer.TestEnum2;
+
+Var
+  E : TEnumcomponent;
+
+begin
+  E:=TEnumComponent.Create(Nil);
+  DeStream('{ "Dice" : "three" }',E);
+  AssertEquals('Correct value',GetEnumName(TypeInfo(TDice),Ord(Three)),GetEnumName(TypeInfo(TDice),Ord(E.Dice)));
+end;
+
+procedure TTestJSONDeStreamer.TestSet1;
+
+Var
+  T : TSetComponent;
+
+begin
+  T:=TSetComponent.Create(Nil);
+  DeStream('{ "Throw" : "one,two" }',T);
+  If not (T.Throw=[one,two]) then
+    Fail('Correct value for throw');
+end;
+
+procedure TTestJSONDeStreamer.TestSet2;
+
+Var
+  T : TSetComponent;
+
+begin
+  T:=TSetComponent.Create(Nil);
+  DeStream('{ "Throw" : "[one,two]" }',T);
+  If not (T.Throw=[one,two]) then
+    Fail('Correct value for throw');
+end;
+
+procedure TTestJSONDeStreamer.TestSet3;
+
+Var
+  T : TSetComponent;
+
+begin
+  T:=TSetComponent.Create(Nil);
+  DeStream('{ "Throw" : [ "one", "two"] }',T);
+  If not (T.Throw=[one,two]) then
+    Fail('Correct value for throw');
+end;
+
+procedure TTestJSONDeStreamer.TestSet4;
+
+Var
+  T : TSetComponent;
+
+begin
+  T:=TSetComponent.Create(Nil);
+  DeStream('{ "Throw" : [ 0 , 1 ] }',T);
+  If not (T.Throw=[one,two]) then
+    Fail('Correct value for throw');
+end;
+
+procedure TTestJSONDeStreamer.TestVariantProp;
+Var
+  V : TVariantComponent;
+
+begin
+  V:=TVariantComponent.Create(Nil);
+  DeStream('{ "VariantProp" : "A string" }',V);
+  AssertEquals('Variant property value','A string',V.VariantProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  DeStream('[ { "StrProp" : "one" }, { "StrProp" : "two" } ]',C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection2;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  DeStream('{ "Items" : [ { "StrProp" : "one" }, { "StrProp" : "two" } ] }',C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection3;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  FTofree:=C;
+  DS.JSONToCollection('{ "Items" : [ { "StrProp" : "one" }, { "StrProp" : "two" } ] }',C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection4;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  FTofree:=C;
+  DS.JSONToCollection('[ { "StrProp" : "one" }, { "StrProp" : "two" } ]',C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection5;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  FTofree:=C;
+  JD:=TJSONArray.Create([TJSONObject.Create(['StrProp','one']),TJSONObject.Create(['StrProp','two'])]);
+  DS.JSONToCollection(JD,C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollection6;
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  FTofree:=C;
+  JD:=TJSONObject.Create(['Items',TJSONArray.Create([TJSONObject.Create(['StrProp','one']),TJSONObject.Create(['StrProp','two'])])]);
+  DS.JSONToCollection(JD,C);
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollectionProp;
+
+Var
+  C : TCollection;
+
+begin
+  JD:=TJSONObject.Create(['Coll',TJSONArray.Create([TJSONObject.Create(['StrProp','one']),TJSONObject.Create(['StrProp','two'])])]);
+  DeStream(JD as TJSONObject,TCollectionComponent.Create(Nil));
+  C:=TCollectionComponent(ToFree).Coll;
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestCollectionProp2;
+
+Var
+  C : TCollection;
+
+begin
+
+  DeStream('{ "Coll" : [ { "StrProp" : "one" }, { "StrProp" : "two" } ]}',TCollectionComponent.Create(Nil));
+  C:=TCollectionComponent(ToFree).Coll;
+  AssertEquals('Item count',2,C.Count);
+  AssertEquals('Class item 0',TTestItem,C.Items[0].ClassType);
+  AssertEquals('Class item 1',TTestItem,C.Items[1].ClassType);
+  AssertEquals('Class item 0','one',TTestItem(C.Items[0]).StrProp);
+  AssertEquals('Class item 1','two',TTestItem(C.Items[1]).StrProp);
+end;
+
+procedure TTestJSONDeStreamer.TestStrings;
+
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  FTofree:=S;
+  DS.JSONToStrings('[ "one" , "two" ]',S);
+  AssertEquals('Item count',2,S.Count);
+  AssertEquals('First item','one',S[0]);
+  AssertEquals('First item','two',S[1]);
+end;
+
+procedure TTestJSONDeStreamer.TestStrings2;
+
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  FTofree:=S;
+  DS.JSONToStrings('{ "Strings" : [ "one" , "two" ] }',S);
+  AssertEquals('Item count',2,S.Count);
+  AssertEquals('First item','one',S[0]);
+  AssertEquals('First item','two',S[1]);
+end;
+
+procedure TTestJSONDeStreamer.TestStrings3;
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  FTofree:=S;
+  DS.JSONToStrings('{ "Strings" : [ "one" , "two" ] }',S);
+  AssertEquals('Item count',2,S.Count);
+  AssertEquals('First item','one',S[0]);
+  AssertEquals('First item','two',S[1]);
+end;
+
+{ TTestJSONStreamer }
+
+function TTestJSONStreamer.StreamObject(AObject: TObject): TJSONObject;
+begin
+  FToFree:=AObject;
+  FSR:=FRJ.ObjectToJSON(AObject);
+  Result:=FSR;
+end;
+
+procedure TTestJSONStreamer.DoStreamProperty1(Sender: TObject; AObject: TObject;
+  Info: PPropInfo; var Res: TJSONData);
+begin
+  If (info^.name<>'IntProp') and (info^.name<>'Name') and (info^.name<>'Tag') then
+    Fail('Wrong property');
+  If (info^.name='IntProp') then
+    FreeAndNil(Res);
+  FCalled:=true;
+end;
+
+procedure TTestJSONStreamer.SetUp;
+begin
+  Inherited;
+  FRJ:=TJSONStreamer.Create(Nil);
+end;
+
+procedure TTestJSONStreamer.TearDown;
+begin
+  FreeAndNil(FSR);
+  FreeAndNil(FRJ);
+  FreeAndNil(FToFree);
+  Inherited;
+end;
+
+procedure TTestJSONStreamer.AssertEquals(AMessage: String; Expected, Actual: TJSONType);
+begin
+  AssertEquals(AMessage,GetEnumName(TypeInfo(TJSONType),Ord(Expected)),
+                        GetEnumName(TypeInfo(TJSONType),Ord(Actual)));
+end;
+
+procedure TTestJSONStreamer.AssertPropCount(ACount: Integer);
+begin
+  AssertNotNull('Result of streaming available',FSR);
+  If FToFree is TComponent then
+    ACount:=ACount+2; // Tag + Name
+  Writeln(FSR.ASJSON);
+  AssertEquals('Property count correct',ACount,FSR.Count);
+end;
+
+function TTestJSONStreamer.AssertProperty(APropName: String; AType: TJSONType
+  ): TJSONData;
+
+Var
+  i : Integer;
+
+begin
+  I:=FSR.IndexOfName(APropName);
+  If (I=-1) then
+    Fail('No property "'+APropName+'" available');
+  Result:=FSR.Items[i];
+  AssertEquals('Property "'+APropName+'" has correct type',GetEnumName(TypeInfo(TJSONType),Ord(AType)),
+                                                           GetEnumName(TypeInfo(TJSONType),Ord(Result.JSONType)));
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: Boolean);
+begin
+  AssertNotNull('Result of streaming available',FSR);
+  AssertEquals('Result of streaming is TJSONObject',TJSONObject,FSR.ClassType);
+  AssertEquals('Correct value',AValue,AssertProperty(APropName,jtBoolean).AsBoolean);
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: Integer);
+begin
+  AssertNotNull('Result of streaming available',FSR);
+  AssertEquals('Result of streaming is TJSONObject',TJSONObject,FSR.ClassType);
+  AssertEquals('Correct value',AValue,AssertProperty(APropName,jtNumber).AsInteger);
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: String);
+begin
+  AssertNotNull('Result of streaming available',FSR);
+  AssertEquals('Result of streaming is TJSONObject',TJSONObject,FSR.ClassType);
+  AssertEquals('Correct value',AValue,AssertProperty(APropName,jtString).AsString);
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: TJSONFloat);
+begin
+  AssertNotNull('Result of streaming available',FSR);
+  AssertEquals('Result of streaming is TJSONObject',TJSONObject,FSR.ClassType);
+  AssertEquals('Correct value',AValue,AssertProperty(APropName,jtNumber).AsFloat);
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: array of String
+  );
+Var
+  a : TJSONArray;
+  i : integer;
+
+begin
+  a:=AssertArrayProp(APropName);
+  AssertEquals('Correct count ',Length(AValue),A.Count);
+  For I:=Low(AValue) to High(Avalue) do
+    begin
+    AssertEquals('Array element type',jtString,A.Types[i]);
+    AssertEquals('Array value',AValue[i],A.strings[i]);
+    end;
+end;
+
+procedure TTestJSONStreamer.AssertProp(APropName: String; AValue: array of Integer
+  );
+Var
+  a : TJSONArray;
+  i : integer;
+
+begin
+  a:=AssertArrayProp(APropName);
+  For I:=Low(AValue) to High(Avalue) do
+    begin
+    AssertEquals('Array element type',jtNumber,A.Types[i]);
+    AssertEquals('Array value',AValue[i],A.Integers[i]);
+    end;
+end;
+
+function TTestJSONStreamer.CreateVariantComp: TVariantComponent;
+begin
+  Result:=TVariantComponent.Create(Nil);
+  FTofree:=Result;
+end;
+
+procedure TTestJSONStreamer.AssertNullProp(APropName: String);
+begin
+  AssertProperty(APropName,jtNull);
+end;
+
+function TTestJSONStreamer.AssertObjectProp(APropName: String): TJSONObject;
+begin
+  Result:=AssertProperty(APropName,jtObject) as TJSONObject;
+end;
+
+function TTestJSONStreamer.AssertArrayProp(APropName: String): TJSONArray;
+begin
+  Result:=AssertProperty(APropName,jtArray) as TJSONArray;
+end;
+
+procedure TTestJSONStreamer.TestNil;
+begin
+  AssertNull('Nil returns nil',StreamObject(Nil));
+end;
+
+procedure TTestJSONStreamer.TestEmpty;
+begin
+  StreamObject(TemptyPersistent.Create);
+  AssertPropCount(0);
+end;
+
+procedure TTestJSONStreamer.TestEmptyComponent;
+begin
+  StreamObject(TComponent.Create(nil));
+  AssertPropCount(0);
+end;
+
+procedure TTestJSONStreamer.TestWriteBoolean;
+
+begin
+  StreamObject(TBooleanComponent.Create(nil));
+  AssertPropCount(1);
+  AssertProp('BooleanProp',False);
+end;
+
+procedure TTestJSONStreamer.TestWriteInteger;
+begin
+  StreamObject(TIntegerComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('IntProp',3);
+end;
+
+procedure TTestJSONStreamer.TestWriteString;
+begin
+  StreamObject(TStringComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('StringProp','A string');
+end;
+
+procedure TTestJSONStreamer.TestWriteFloat;
+begin
+  StreamObject(TSingleComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('SingleProp',1.23);
+end;
+
+procedure TTestJSONStreamer.TestWriteFloat2;
+begin
+  StreamObject(TDoubleComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('DoubleProp',2.34);
+end;
+
+procedure TTestJSONStreamer.TestWriteFloat3;
+begin
+  StreamObject(TExtendedComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('ExtendedProp',3.45);
+end;
+
+procedure TTestJSONStreamer.TestWriteFloat4;
+begin
+  StreamObject(TCompComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('CompProp',5);
+end;
+
+procedure TTestJSONStreamer.TestWriteFloat5;
+begin
+  StreamObject(TCurrencyComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('CurrencyProp',5.67);
+end;
+
+procedure TTestJSONStreamer.TestEnum1;
+begin
+  StreamObject(TEnumComponent3.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('Dice',GetEnumName(TypeInfo(TDice),Ord(three)));
+end;
+
+procedure TTestJSONStreamer.TestEnum2;
+begin
+  RJ.Options:=[jsoEnumeratedAsInteger];
+  StreamObject(TEnumComponent3.Create(Nil));
+  AssertProp('Dice',Ord(three));
+end;
+
+procedure TTestJSONStreamer.TestSet1;
+begin
+  StreamObject(TSetComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('Throw',['two','five']);
+end;
+
+procedure TTestJSONStreamer.TestSet2;
+begin
+  RJ.Options:=[jsoSetAsString];
+  StreamObject(TSetComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('Throw','two,five');
+end;
+
+procedure TTestJSONStreamer.TestSet3;
+begin
+  RJ.Options:=[jsoSetAsString,jsoSetBrackets];
+  StreamObject(TSetComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('Throw','[two,five]');
+end;
+
+procedure TTestJSONStreamer.TestSet4;
+begin
+  RJ.Options:=[jsoSetEnumeratedAsInteger];
+  StreamObject(TSetComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('Throw',[Ord(two),Ord(five)]);
+end;
+
+procedure TTestJSONStreamer.TestObjectNil;
+
+Var
+  P : TOwnedComponent;
+
+begin
+  P:=TOwnedComponent.Create(Nil);
+  P.CompProp.Free;
+  P.CompProp:=Nil;
+  StreamObject(P);
+  AssertPropCount(1);
+  AssertNullProp('CompProp');
+end;
+
+procedure TTestJSONStreamer.TestComponentProp1;
+begin
+  StreamObject(TOwnedComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('CompProp','SubComponent');
+end;
+
+procedure TTestJSONStreamer.TestComponentProp2;
+
+Var
+  C : TOwnedComponent;
+  F : TJSONObject;
+
+begin
+  RJ.Options:=[jsoComponentsInline];
+  C:=TOwnedComponent.Create(Nil);
+  StreamObject(C);
+  AssertPropCount(1);
+  F:=SR;
+  try
+    SR:=AssertObjectProp('CompProp');
+    AssertPropCount(1);
+    AssertProp('Name','SubComponent');
+    Assertprop('Tag',0);
+    AssertProp('IntProp',3);
+  finally
+    SR:=F;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestCollectionProp1;
+
+Var
+  C : TCollectionComponent;
+  F : TJSONObject;
+  A : TJSONArray;
+
+begin
+  C:=TCollectionComponent2.Create(Nil);
+  StreamObject(C);
+  AssertPropCount(1);
+  F:=SR;
+  try
+    A:=AssertArrayProp('Coll');
+    AssertEquals('Collection item cound',3,A.Count);
+    AssertEquals('Item 0 is object',jtObject,A.Types[0]);
+    SR:=A.Objects[0];
+    FToFree:=SR;
+    AssertPropCount(1);
+    AssertProp('StrProp','First');
+    AssertEquals('Item 1 is object',jtObject,A.Types[1]);
+    SR:=A.Objects[1];
+    FToFree:=SR;
+    AssertPropCount(1);
+    AssertProp('StrProp','Second');
+    AssertEquals('Item 2 is object',jtObject,A.Types[2]);
+    SR:=A.Objects[2];
+    FToFree:=SR;
+    AssertPropCount(1);
+    AssertProp('StrProp','Third');
+  finally
+    SR:=F;
+    FToFree:=C;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestCollectionProp2;
+
+Var
+  C : TCollectionComponent;
+  A : TJSONArray;
+
+begin
+  C:=TCollectionComponent.Create(Nil);
+  StreamObject(C);
+  AssertPropCount (1);
+  A:=AssertArrayProp('Coll');
+  AssertEquals('Collection item count',0,A.Count);
+end;
+
+procedure TTestJSONStreamer.TestPersistentProp1;
+
+var
+  P : TPersistentComponent;
+  F : TJSONObject;
+
+begin
+  P:=TPersistentComponent.Create(Nil);
+  StreamObject(P);
+  AssertPropCount(1);
+  F:=SR;
+  try
+    SR:=AssertObjectProp('Persist');
+    FToFree:=P.Persist;
+    AssertPropCount(2);
+    AssertProp('AString','A persistent string');
+    AssertProp('AInteger',3);
+  finally
+    FToFree:=P;
+    SR:=F;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsProp1;
+
+begin
+  RJ.Options:=[jsoTstringsAsArray];
+  StreamObject(TStringsCOmponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('StringsProp',['One','Two','Three']);
+end;
+
+procedure TTestJSONStreamer.TestStringsProp2;
+
+begin
+  StreamObject(TStringsCOmponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('StringsProp','One'+sLineBreak+'Two'+sLineBreak+'Three'+sLineBreak);
+end;
+
+procedure TTestJSONStreamer.TestStringsProp3;
+
+Var
+  O : TJSONObject;
+  S : TStringsComponent;
+
+begin
+  S:=TStringsCOmponent.Create(Nil);
+  RJ.Options:=[jsoTstringsAsObject];
+  StreamObject(S);
+  AssertPropCount(1);
+  O:=SR;
+  SR:=AssertObjectprop('StringsProp');
+  FTofree:=Nil;
+  try
+    AssertNullProp('One');
+    AssertNullProp('Two');
+    AssertNullProp('Three');
+  finally
+    SR:=o;
+    FToFree:=S;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsProp4;
+
+Var
+  O,SP : TJSONObject;
+  S : TStringsComponent;
+
+begin
+  S:=TStringsCOmponent.Create(Nil);
+  S.StringsProp.Objects[0]:=TEmptyPersistent.Create;
+  S.StringsProp.Objects[1]:=TEmptyPersistent.Create;
+  S.StringsProp.Objects[2]:=TEmptyPersistent.Create;
+  try
+    RJ.Options:=[jsoTstringsAsObject];
+    StreamObject(S);
+    AssertPropCount(1);
+    O:=SR;
+    SP:=AssertObjectprop('StringsProp');
+    SR:=SP;
+    FTofree:=Nil;
+    try
+      SR:=AssertObjectProp('One');
+      AssertPropCount(0);
+      SR:=SP;
+      SR:=AssertObjectProp('Two');
+      AssertPropCount(0);
+      SR:=SP;
+      SR:=AssertObjectProp('Three');
+      AssertPropCount(0);
+    finally
+      SR:=o;
+      FToFree:=S;
+    end;
+  finally
+    S.StringsProp.Objects[0].Free;
+    S.StringsProp.Objects[1].Free;
+    S.StringsProp.Objects[2].Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsArray;
+
+Var
+  O : TJSONArray;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.Add('one');
+    O:=RJ.StreamTStringsArray(S);
+    try
+      AssertEquals('one element',1,O.Count);
+      AssertEquals('string type',jtString,O.Types[0]);
+      AssertEquals('string value','one',O.Strings[0]);
+    finally
+      FreeAndNil(O);
+    end;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsObject;
+
+Var
+  O : TJSONObject;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.AddObject('one',TEmptyPersistent.Create);
+    O:=RJ.StreamTStringsObject(S);
+    try
+      AssertEquals('one element',1,O.Count);
+      AssertEquals('Have property',0,O.IndexOfName('one'));
+      AssertEquals('string type',jtObject,O.Types['one']);
+      AssertEquals('string value','one',O.Names[0]);
+    finally
+      FreeAndNil(O);
+    end;
+  finally
+    S.Objects[0].FRee;
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsStream1;
+
+Var
+  D: TJSONData;
+  O : TJSONArray;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.Add('one');
+    RJ.Options:=[jsoTstringsAsArray];
+    D:=RJ.StreamTStrings(S);
+    try
+      AssertEquals('Correct type',jtArray,D.JSONType);
+      O:=D as TJSONArray;
+      AssertEquals('one element',1,O.Count);
+      AssertEquals('string type',jtString,O.Types[0]);
+      AssertEquals('string value','one',O.Strings[0]);
+    finally
+      FreeAndNil(O);
+    end;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsStream2;
+
+Var
+  D : TJSONData;
+  O : TJSONObject;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.AddObject('one',TEmptyPersistent.Create);
+    RJ.Options:=[jsoTstringsAsObject];
+    D:=RJ.StreamTstrings(S);
+    try
+      AssertEquals('Correct type',jtObject,D.JSONType);
+      O:=D as TJSONObject;
+      AssertEquals('one element',1,O.Count);
+      AssertEquals('Have property',0,O.IndexOfName('one'));
+      AssertEquals('string type',jtObject,O.Types['one']);
+      AssertEquals('string value','one',O.Names[0]);
+    finally
+      SR:=O;
+    end;
+  finally
+    S.Objects[0].FRee;
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsStream3;
+Var
+  O : TJSONObject;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.AddObject('one',TEmptyPersistent.Create);
+    RJ.Options:=[jsoTstringsAsObject];
+    SR:=RJ.ObjectToJSON(S);
+    O:=AssertObjectProp('Strings');
+    AssertEquals('one element',1,O.Count);
+    AssertEquals('Have property',0,O.IndexOfName('one'));
+    AssertEquals('string type',jtObject,O.Types['one']);
+    AssertEquals('string value','one',O.Names[0]);
+  finally
+    S.Objects[0].FRee;
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsStream4;
+Var
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.AddObject('one',TEmptyPersistent.Create);
+    SR:=RJ.ObjectToJSON(S);
+    AssertProp('Strings','one'+sLinebreak);
+  finally
+    S.Objects[0].FRee;
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestStringsStream5;
+Var
+  D : TJSONData;
+  S : TStringList;
+
+begin
+  S:=TStringList.create;
+  try
+    S.AddObject('one',TEmptyPersistent.Create);
+    D:=RJ.StreamTstrings(S);
+    try
+      AssertEquals('String data',jtString,D.JSONType);
+      AssertEquals('String value','one'+sLineBreak,D.AsString);
+    finally
+      D.free;
+    end;
+  finally
+    S.Objects[0].FRee;
+    S.Free;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestCollectionStream;
+
+Var
+  C : TTestCollection;
+  A : TJSONArray;
+
+begin
+  C:=TTestCollection.Create;
+  FToFree:=C;
+  TTestItem(C.Add).StrProp:='One';
+  TTestItem(C.Add).StrProp:='Two';
+  A:=RJ.StreamCollection(C);
+  try
+    AssertNotNull('Have result',A);
+    AssertEquals('2 items',2,A.Count);
+    AssertEquals('Type item 0,',jtObject,A.Types[0]);
+    AssertEquals('Type item 1,',jtObject,A.Types[1]);
+    SR:=A.Objects[0];
+    AssertPropCount(1);
+    AssertProp('StrProp','One');
+    SR:=A.Objects[1];
+    AssertPropCount(1);
+    AssertProp('StrProp','Two');
+    SR:=Nil;
+  finally
+    FreeAndNil(A);
+  end;
+end;
+
+procedure TTestJSONStreamer.TestCollectionStream2;
+
+Var
+  C : TTestCollection;
+  A : TJSONArray;
+  o : TJSONObject;
+
+begin
+  C:=TTestCollection.Create;
+  TTestItem(C.Add).StrProp:='One';
+  TTestItem(C.Add).StrProp:='Two';
+  FToFree:=C;
+  StreamObject(C);
+  O:=SR;
+  try
+    A:=AssertProperty('Items',jtArray) as TJSONArray;
+    AssertNotNull('Have result',A);
+    AssertEquals('2 items',2,A.Count);
+    AssertEquals('Type item 0,',jtObject,A.Types[0]);
+    AssertEquals('Type item 1,',jtObject,A.Types[1]);
+    SR:=A.Objects[0];
+    AssertPropCount(1);
+    AssertProp('StrProp','One');
+    SR:=A.Objects[1];
+    AssertPropCount(1);
+    AssertProp('StrProp','Two');
+    SR:=Nil;
+  finally
+    SR:=O;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestOnStreamProperty;
+begin
+  RJ.OnStreamProperty:=@DoStreamProperty1;
+  StreamObject(TIntegerComponent.Create(Nil));
+  AssertPropCount(0);
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp;
+
+Var
+  D : Double;
+begin
+  StreamObject(TDateTimeComponent.Create(Nil));
+  D:=EncodeDate(1996,8,1);
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',D);
+end;
+
+procedure TTestJSONStreamer.TestDateTimePropDefaultString;
+
+Var
+  D : Double;
+begin
+  RJ.Options:=[jsoDateTimeAsString];
+  StreamObject(TDateTimeComponent.Create(Nil));
+  D:=EncodeDate(1996,8,1);
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',FormatDateTime(RFC3339DateTimeFormat,D));
+end;
+
+procedure TTestJSONStreamer.TestDateTimePropDefaultStringTime;
+Var
+  D : Double;
+begin
+  RJ.Options:=[jsoDateTimeAsString];
+  StreamObject(TDateTimeComponent3.Create(Nil));
+  D:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0);
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',FormatDateTime(RFC3339DateTimeFormat,D));
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp2;
+Var
+  D : Double;
+begin
+  StreamObject(TDateTimeComponent2.Create(Nil));
+  D:=EncodeTime(23,20,0,0);
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',D);
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp3;
+Var
+  D : Double;
+begin
+  StreamObject(TDateTimeComponent3.Create(Nil));
+  D:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0);
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',D);
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp4;
+
+begin
+  RJ.Options:=[jsoDateTimeAsString,jsoLegacyDateTime];
+  StreamObject(TDateTimeComponent.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',DateToStr(EncodeDate(1996,8,1)));
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp5;
+
+begin
+  RJ.Options:=[jsoDateTimeAsString,jsoLegacyDateTime];
+  StreamObject(TDateTimeComponent2.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',TimeToStr(EncodeTime(23,20,0,0)));
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp6;
+
+begin
+  RJ.Options:=[jsoDateTimeAsString,jsoLegacyDateTime];
+  StreamObject(TDateTimeComponent3.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',DateTimeToStr(EncodeDate(1996,8,1)+EncodeTime(23,20,0,0)));
+end;
+
+procedure TTestJSONStreamer.TestDateTimeProp7;
+begin
+  RJ.Options:=[jsoDateTimeAsString];
+  RJ.DateTimeFormat:='hh:nn';
+  StreamObject(TDateTimeComponent3.Create(Nil));
+  AssertPropCount(1);
+  AssertProp('DateTimeProp',FormatDateTime('hh:nn',EncodeDate(1996,8,1)+EncodeTime(23,20,0,0)));
+end;
+
+procedure TTestJSONStreamer.TestVariantShortint;
+
+Var
+  i : ShortInt;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varshortint),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantbyte;
+Var
+  i : Byte;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varByte),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantword;
+
+Var
+  i : Word;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varWord),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantsmallint;
+
+Var
+  i : Smallint;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varSmallint),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantinteger;
+Var
+  i : Integer;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varInteger),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantlongword;
+
+Var
+  i : Cardinal;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varLongword),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantint64;
+Var
+  i : Int64;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varInt64),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantqword;
+Var
+  i : QWord;
+  C : TVariantComponent;
+
+begin
+  i:=3;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varQWord),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3);
+end;
+
+procedure TTestJSONStreamer.TestVariantsingle;
+Var
+  i : Single;
+  C : TVariantComponent;
+
+begin
+  i:=3.14;
+  C:=CreateVariantComp;
+  C.VariantProp:=VarAsType(3.14,varSingle);
+  AssertEquals('Variant type',VarTypeAsText(varSingle),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',i);
+end;
+
+procedure TTestJSONStreamer.TestVariantdouble;
+
+Var
+  i : Double;
+  C : TVariantComponent;
+
+begin
+  i:=3.14;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varDouble),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3.14);
+end;
+
+procedure TTestJSONStreamer.TestVariantCurrency;
+Var
+  i : Currency;
+  C : TVariantComponent;
+
+begin
+  i:=3.14;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varCurrency),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',3.14);
+end;
+
+procedure TTestJSONStreamer.TestVariantString;
+
+Var
+  i : String;
+  C : TVariantComponent;
+
+begin
+  i:='3.14';
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varString),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp','3.14');
+end;
+
+procedure TTestJSONStreamer.TestVariantolestr;
+
+Var
+  i : String;
+  C : TVariantComponent;
+
+begin
+  i:='3.14';
+  C:=CreateVariantComp;
+  C.VariantProp:=VarAsType(i,varOleStr);
+  AssertEquals('Variant type',VarTypeAsText(varOleStr),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp','3.14');
+end;
+
+procedure TTestJSONStreamer.TestVariantboolean;
+Var
+  i : Boolean;
+  C : TVariantComponent;
+
+begin
+  i:=True;
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varBoolean),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',True);
+end;
+
+procedure TTestJSONStreamer.TestVariantDate;
+
+Var
+  i : TDateTime;
+  C : TVariantComponent;
+
+begin
+  i:=EncodeDate(2010,12,23);
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varDate),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',EncodeDate(2010,12,23));
+end;
+
+procedure TTestJSONStreamer.TestVariantDate2;
+
+Var
+  i : TDateTime;
+  C : TVariantComponent;
+
+begin
+  RJ.Options:=[jsoDateTimeAsString,jsoLegacyDateTime];
+  i:=EncodeDate(2010,12,23);
+  C:=CreateVariantComp;
+  C.VariantProp:=i;
+  AssertEquals('Variant type',VarTypeAsText(varDate),VarTypeAsText(VarType(C.VariantProp)));
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  AssertProp('VariantProp',DateToStr(EncodeDate(2010,12,23)));
+end;
+
+procedure TTestJSONStreamer.TestVariantArray;
+Var
+  i : Integer;
+  V : Variant;
+  C : TVariantComponent;
+  A : TJSONArray;
+
+begin
+  V:=VarArrayCreate([1,10],varInteger);
+  For I:=1 to 10 do
+    V[i]:=11-I;
+  C:=CreateVariantComp;
+  C.VariantProp:=V;
+  StreamObject(FTofree);
+  AssertPropCount(1);
+  A:=AssertProperty('VariantProp',jtArray) as TJSONArray;
+  AssertEquals('10 elements in array',10,A.Count);
+  For I:=1 to 10 do
+    begin
+    assertEquals('Type of element',jtNumber,A.Types[i-1]);
+    AssertEquals('Value of element',11-i,A.Integers[i-1]);
+    end;
+end;
+
+procedure TTestJSONStreamer.TestMultipleProps;
+begin
+  StreamObject(TMultipleComponent.Create(Nil));
+  AssertPropCount(5);
+  AssertProp('IntProp',1);
+  Assertprop('StringProp','A String');
+  AssertProp('CurrencyProp',2.3);
+  AssertProp('Throw',['three','four']);
+  AssertProp('Dice','two');
+end;
+
+procedure TTestJSONStreamer.TestObjectToJSONString;
+begin
+  StreamObject(TIntegerComponent.Create(Nil));
+  AssertEquals('Correct stream',SR.AsJSON,RJ.ObjectToJSONString(FToFree));
+end;
+
+procedure TTestJSONStreamer.TestStringsToJSONString;
+Var
+  S : TStrings;
+begin
+  S:=TStringList.Create;
+  try
+    S.Add('one');
+    S.Add('two');
+    S.Add('three');
+    AssertEquals('StringsToJSONString','["one", "two", "three"]',RJ.StringsToJSON(S));
+    AssertEquals('StringsToJSONString','{ "one" : null, "two" : null, "three" : null }',RJ.StringsToJSON(S,True));
+  finally
+    FreeAndNil(S);
+  end;
+end;
+
+procedure TTestJSONStreamer.TestTListToJSONString ;
+
+
+Var
+  C : TList;
+  D : TJSONData;
+  P : Pointer;
+
+  Function Add : TTestItem;
+
+  begin
+    Result:=TTestItem.Create(Nil);
+    C.Add(Result);
+  end;
+
+begin
+  RJ.Options:=RJ.Options + [jsoStreamTList];
+  C:=TList.Create;
+  try
+    Add.StrProp:='one';
+    Add.StrProp:='two';
+    Add.StrProp:='three';
+    D:=RJ.StreamTList(C);
+    AssertEquals('StreamTlist','[{ "StrProp" : "one" }, { "StrProp" : "two" }, { "StrProp" : "three" }]',D.AsJSON);
+  finally
+    D.Free;
+    For P in C do
+      TObject(P).Free;
+    FreeAndNil(C);
+  end;
+end;
+
+procedure TTestJSONStreamer.TestCollectionToJSONString;
+
+Var
+  C : TTestCollection;
+
+begin
+  C:=TTestCollection.Create;
+  try
+    (C.Add as TTestItem).StrProp:='one';
+    (C.Add as TTestItem).StrProp:='two';
+    (C.Add as TTestItem).StrProp:='three';
+    AssertEquals('CollectionToJSON','[{ "StrProp" : "one" }, { "StrProp" : "two" }, { "StrProp" : "three" }]',RJ.CollectionToJSON(C));
+  finally
+    FreeAndNil(C);
+  end;
+end;
+
+procedure TTestJSONStreamer.TestChildren;
+
+Var
+  C : TChildrenComponent;
+
+begin
+  C:=TChildrenComponent.Create(Nil);
+  TComponent.Create(C).Name:='Child1';
+  TComponent.Create(C).Name:='Child2';
+  StreamObject(C);
+  If SR.IndexOfName('Children')<>-1 then
+    Fail('Children streamed with default options');
+
+end;
+
+procedure TTestJSONStreamer.TestChildren2;
+Var
+  C : TChildrenComponent;
+  A : TJSONArray;
+  O : TJSONObject;
+
+begin
+  C:=TChildrenComponent.Create(Nil);
+  TComponent.Create(C).Name:='Child1';
+  TComponent.Create(C).Name:='Child2';
+  RJ.Options:=[jsoStreamChildren];
+  StreamObject(C);
+  AssertPropCount(1);
+  A:=AssertProperty('Children',jtArray) as TJSONArray;
+  O:=SR;
+  try
+    AssertEquals('2 Elements in array',2,A.Count);
+    AssertEquals('First in array is object',jtObject,A.Types[0]);
+    AssertEquals('Second in array is object',jtObject,A.Types[1]);
+    SR:=A.Objects[0];
+    AssertProp('Name','Child1');
+    SR:=A.Objects[1];
+    AssertProp('Name','Child2');
+  finally
+    SR:=O;
+  end;
+end;
+
+procedure TTestJSONStreamer.TestLowercase;
+begin
+  RJ.Options:=RJ.Options+[jsoLowerPropertyNames];
+  StreamObject(TBooleanComponent.Create(nil));
+  AssertPropCount(1);
+  AssertProp('booleanprop',False);
+end;
+
+initialization
+
+  RegisterTests([TTestJSONStreamer,TTestJSONDeStreamer]);
+end.
+

BIN
compiler/packages/fcl-json/units/x86_64-linux/fpjson.ppu


+ 22 - 0
compiler/packages/fcl-json/units/x86_64-linux/fpjson.rsj

@@ -0,0 +1,22 @@
+{"version":1,"strings":[
+{"hash":164499877,"name":"fpjson.serrcannotconvertfromnull","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,102,114,111,109,32,78,117,108,108,32,118,97,108,117,101],"value":"Cannot convert data from Null value"},
+{"hash":13335717,"name":"fpjson.serrcannotconverttonull","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,116,111,32,78,117,108,108,32,118,97,108,117,101],"value":"Cannot convert data to Null value"},
+{"hash":4610117,"name":"fpjson.serrcannotconvertfromarray","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,102,114,111,109,32,97,114,114,97,121,32,118,97,108,117,101],"value":"Cannot convert data from array value"},
+{"hash":3197141,"name":"fpjson.serrcannotconverttoarray","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,116,111,32,97,114,114,97,121,32,118,97,108,117,101],"value":"Cannot convert data to array value"},
+{"hash":34561957,"name":"fpjson.serrcannotconvertfromobject","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,102,114,111,109,32,111,98,106,101,99,116,32,118,97,108,117,101],"value":"Cannot convert data from object value"},
+{"hash":56776357,"name":"fpjson.serrcannotconverttoobject","sourcebytes":[67,97,110,110,111,116,32,99,111,110,118,101,114,116,32,100,97,116,97,32,116,111,32,111,98,106,101,99,116,32,118,97,108,117,101],"value":"Cannot convert data to object value"},
+{"hash":158801795,"name":"fpjson.serrinvalidfloat","sourcebytes":[73,110,118,97,108,105,100,32,102,108,111,97,116,32,118,97,108,117,101,32,58,32,37,115],"value":"Invalid float value : %s"},
+{"hash":16809925,"name":"fpjson.serrcannotsetnotisnull","sourcebytes":[73,115,78,117,108,108,32,99,97,110,110,111,116,32,98,101,32,115,101,116,32,116,111,32,70,97,108,115,101],"value":"IsNull cannot be set to False"},
+{"hash":263172452,"name":"fpjson.serrcannotaddarraytwice","sourcebytes":[65,100,100,105,110,103,32,97,110,32,97,114,114,97,121,32,111,98,106,101,99,116,32,116,111,32,97,110,32,97,114,114,97,121,32,116,119,105,99,101,32,105,115,32,110,111,116,32,97,108,108,111,119,101,100],"value":"Adding an array object to an array twice is not allowed"},
+{"hash":119724340,"name":"fpjson.serrcannotaddobjecttwice","sourcebytes":[65,100,100,105,110,103,32,97,110,32,111,98,106,101,99,116,32,116,111,32,97,110,32,97,114,114,97,121,32,116,119,105,99,101,32,105,115,32,110,111,116,32,97,108,108,111,119,101,100],"value":"Adding an object to an array twice is not allowed"},
+{"hash":44747796,"name":"fpjson.serrunknowntypeinconstructor","sourcebytes":[85,110,107,110,111,119,110,32,116,121,112,101,32,105,110,32,74,83,79,78,37,115,32,99,111,110,115,116,114,117,99,116,111,114,58,32,37,100],"value":"Unknown type in JSON%s constructor: %d"},
+{"hash":127458243,"name":"fpjson.serrnotjsondata","sourcebytes":[67,97,110,110,111,116,32,97,100,100,32,111,98,106,101,99,116,32,111,102,32,116,121,112,101,32,37,115,32,116,111,32,84,74,83,79,78,37,115],"value":"Cannot add object of type %s to TJSON%s"},
+{"hash":84018003,"name":"fpjson.serroddnumber","sourcebytes":[84,74,83,79,78,79,98,106,101,99,116,32,109,117,115,116,32,98,101,32,99,111,110,115,116,114,117,99,116,101,100,32,119,105,116,104,32,110,97,109,101,44,118,97,108,117,101,32,112,97,105,114,115],"value":"TJSONObject must be constructed with name,value pairs"},
+{"hash":203101655,"name":"fpjson.serrnamemustbestring","sourcebytes":[84,74,83,79,78,79,98,106,101,99,116,32,99,111,110,115,116,114,117,99,116,111,114,32,101,108,101,109,101,110,116,32,110,97,109,101,32,97,116,32,112,111,115,32,37,100,32,105,115,32,110,111,116,32,97,32,115,116,114,105,110,103],"value":"TJSONObject constructor element name at pos %d is not a string"},
+{"hash":119296690,"name":"fpjson.serrnonexistentelement","sourcebytes":[85,110,107,110,111,119,110,32,111,98,106,101,99,116,32,109,101,109,98,101,114,58,32,34,37,115,34],"value":"Unknown object member: \"%s\""},
+{"hash":144420514,"name":"fpjson.serrduplicatevalue","sourcebytes":[68,117,112,108,105,99,97,116,101,32,111,98,106,101,99,116,32,109,101,109,98,101,114,58,32,34,37,115,34],"value":"Duplicate object member: \"%s\""},
+{"hash":132398958,"name":"fpjson.serrpathelementnotfound","sourcebytes":[80,97,116,104,32,34,37,115,34,32,105,110,118,97,108,105,100,58,32,101,108,101,109,101,110,116,32,34,37,115,34,32,110,111,116,32,102,111,117,110,100,46],"value":"Path \"%s\" invalid: element \"%s\" not found."},
+{"hash":133699358,"name":"fpjson.serrwronginstanceclass","sourcebytes":[67,97,110,110,111,116,32,115,101,116,32,105,110,115,116,97,110,99,101,32,99,108,97,115,115,58,32,37,115,32,100,111,101,115,32,110,111,116,32,100,101,115,99,101,110,100,32,102,114,111,109,32,37,115,46],"value":"Cannot set instance class: %s does not descend from %s."},
+{"hash":126211171,"name":"fpjson.serrpointernotnil","sourcebytes":[67,97,110,110,111,116,32,97,100,100,32,110,111,110,45,110,105,108,32,112,111,105,110,116,101,114,32,116,111,32,74,83,79,78,37,115],"value":"Cannot add non-nil pointer to JSON%s"},
+{"hash":152621460,"name":"fpjson.serrnoparserhandler","sourcebytes":[78,111,32,74,83,79,78,32,112,97,114,115,101,114,32,104,97,110,100,108,101,114,32,105,110,115,116,97,108,108,101,100,46,32,82,101,99,111,109,112,105,108,101,32,121,111,117,114,32,112,114,111,106,101,99,116,32,119,105,116,104,32,116,104,101,32,106,115,111,110,112,97,114,115,101,114,32,117,110,105,116,32,105,110,99,108,117,100,101,100],"value":"No JSON parser handler installed. Recompile your project with the jsonparser unit included"}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/fpjsonrtti.ppu


+ 15 - 0
compiler/packages/fcl-json/units/x86_64-linux/fpjsonrtti.rsj

@@ -0,0 +1,15 @@
+{"version":1,"strings":[
+{"hash":154818594,"name":"fpjsonrtti.serrunknownpropertykind","sourcebytes":[85,110,107,110,111,119,110,32,112,114,111,112,101,114,116,121,32,107,105,110,100,32,102,111,114,32,112,114,111,112,101,114,116,121,32,58,32,34,37,115,34],"value":"Unknown property kind for property : \"%s\""},
+{"hash":222493842,"name":"fpjsonrtti.serrunsupportedpropertykind","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,112,114,111,112,101,114,116,121,32,107,105,110,100,32,102,111,114,32,112,114,111,112,101,114,116,121,58,32,34,37,115,34],"value":"Unsupported property kind for property: \"%s\""},
+{"hash":18085428,"name":"fpjsonrtti.serrunsupportedvarianttype","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,118,97,114,105,97,110,116,32,116,121,112,101,32,58,32,37,100],"value":"Unsupported variant type : %d"},
+{"hash":185800146,"name":"fpjsonrtti.serrunsupportedarraytype","sourcebytes":[74,83,79,78,32,97,114,114,97,121,32,99,97,110,110,111,116,32,98,101,32,115,116,114,101,97,109,101,100,32,116,111,32,111,98,106,101,99,116,32,111,102,32,99,108,97,115,115,32,34,37,115,34],"value":"JSON array cannot be streamed to object of class \"%s\""},
+{"hash":142123154,"name":"fpjsonrtti.serrunsupportedjsontype","sourcebytes":[67,97,110,110,111,116,32,100,101,115,116,114,101,97,109,32,111,98,106,101,99,116,32,102,114,111,109,32,74,83,79,78,32,100,97,116,97,32,111,102,32,116,121,112,101,32,34,37,115,34],"value":"Cannot destream object from JSON data of type \"%s\""},
+{"hash":212044930,"name":"fpjsonrtti.serrunsupportedcollectiontype","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,74,83,79,78,32,116,121,112,101,32,102,111,114,32,99,111,108,108,101,99,116,105,111,110,115,58,32,34,37,115,34],"value":"Unsupported JSON type for collections: \"%s\""},
+{"hash":170539922,"name":"fpjsonrtti.serrunsupportedcollectionitemtype","sourcebytes":[65,114,114,97,121,32,101,108,101,109,101,110,116,32,37,100,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,121,112,101,32,102,111,114,32,97,32,99,111,108,108,101,99,116,105,111,110,32,105,116,101,109,58,32,34,37,115,34],"value":"Array element %d is not a valid type for a collection item: \"%s\""},
+{"hash":199975138,"name":"fpjsonrtti.serrunsupportedstringsitemtype","sourcebytes":[65,114,114,97,121,32,101,108,101,109,101,110,116,32,37,100,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,121,112,101,32,102,111,114,32,97,32,115,116,114,105,110,103,108,105,115,116,32,105,116,101,109,58,32,34,37,115,34],"value":"Array element %d is not a valid type for a stringlist item: \"%s\""},
+{"hash":64939394,"name":"fpjsonrtti.serrunsupportedstringstype","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,74,83,79,78,32,116,121,112,101,32,102,111,114,32,115,116,114,105,110,103,108,105,115,116,115,58,32,34,37,115,34],"value":"Unsupported JSON type for stringlists: \"%s\""},
+{"hash":188513362,"name":"fpjsonrtti.serrunsupportedstringsobjecttype","sourcebytes":[79,98,106,101,99,116,32,69,108,101,109,101,110,116,32,37,115,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,121,112,101,32,102,111,114,32,97,32,115,116,114,105,110,103,108,105,115,116,32,111,98,106,101,99,116,58,32,34,37,115,34],"value":"Object Element %s is not a valid type for a stringlist object: \"%s\""},
+{"hash":40549010,"name":"fpjsonrtti.serrunsupportedenumdatatype","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,74,83,79,78,32,116,121,112,101,32,102,111,114,32,101,110,117,109,101,114,97,116,101,100,32,112,114,111,112,101,114,116,121,32,34,37,115,34,32,58,32,34,37,115,34],"value":"Unsupported JSON type for enumerated property \"%s\" : \"%s\""},
+{"hash":221319090,"name":"fpjsonrtti.serrunsupportedvariantjsontype","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,74,83,79,78,32,116,121,112,101,32,102,111,114,32,118,97,114,105,97,110,116,32,118,97,108,117,101,32,58,32,34,37,115,34],"value":"Unsupported JSON type for variant value : \"%s\""},
+{"hash":146748466,"name":"fpjsonrtti.serrunsupportedobjectdata","sourcebytes":[85,110,115,117,112,112,111,114,116,101,100,32,74,83,79,78,32,116,121,112,101,32,102,111,114,32,111,98,106,101,99,116,32,112,114,111,112,101,114,116,121,58,32,34,37,115,34],"value":"Unsupported JSON type for object property: \"%s\""}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/fpjsontopas.ppu


+ 5 - 0
compiler/packages/fcl-json/units/x86_64-linux/fpjsontopas.rsj

@@ -0,0 +1,5 @@
+{"version":1,"strings":[
+{"hash":219335488,"name":"fpjsontopas.serrcannotdeterminetype","sourcebytes":[67,97,110,110,111,116,32,100,101,116,101,114,109,105,110,101,32,116,121,112,101,32,102,111,114,32,37,115,32,58,32,78,111,116,32,105,110,32,116,121,112,101,32,109,97,112],"value":"Cannot determine type for %s : Not in type map"},
+{"hash":138870979,"name":"fpjsontopas.serrcannotdeterminepropertytype","sourcebytes":[67,97,110,110,111,116,32,100,101,116,101,114,109,105,110,101,32,112,114,111,112,101,114,116,121,32,116,121,112,101,32,102,111,114,32,37,115],"value":"Cannot determine property type for %s"},
+{"hash":90616450,"name":"fpjsontopas.serrcannotgeneratearraydeclaration","sourcebytes":[67,97,110,110,111,116,32,103,101,110,101,114,97,116,101,32,97,114,114,97,121,32,100,101,99,108,97,114,97,116,105,111,110,32,102,114,111,109,32,101,109,112,116,121,32,97,114,114,97,121,32,97,116,32,34,37,115,34],"value":"Cannot generate array declaration from empty array at \"%s\""}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/json2yaml.ppu


BIN
compiler/packages/fcl-json/units/x86_64-linux/jsonconf.ppu


+ 5 - 0
compiler/packages/fcl-json/units/x86_64-linux/jsonconf.rsj

@@ -0,0 +1,5 @@
+{"version":1,"strings":[
+{"hash":246587102,"name":"jsonconf.serrinvalidjsonfile","sourcebytes":[34,37,115,34,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,74,83,79,78,32,99,111,110,102,105,103,117,114,97,116,105,111,110,32,102,105,108,101,46],"value":"\"%s\" is not a valid JSON configuration file."},
+{"hash":242487694,"name":"jsonconf.serrcouldnotopenkey","sourcebytes":[67,111,117,108,100,32,110,111,116,32,111,112,101,110,32,107,101,121,32,34,37,115,34,46],"value":"Could not open key \"%s\"."},
+{"hash":12426702,"name":"jsonconf.serrcannotnotreplacekey","sourcebytes":[65,32,40,115,117,98,41,107,101,121,32,119,105,116,104,32,110,97,109,101,32,34,37,115,34,32,97,108,114,101,97,100,121,32,101,120,105,115,116,115,46],"value":"A (sub)key with name \"%s\" already exists."}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/jsonini.ppu


BIN
compiler/packages/fcl-json/units/x86_64-linux/jsonparser.ppu


+ 3 - 0
compiler/packages/fcl-json/units/x86_64-linux/jsonparser.rsj

@@ -0,0 +1,3 @@
+{"version":1,"strings":[
+{"hash":96664706,"name":"jsonparser.serrstructure","sourcebytes":[83,116,114,117,99,116,117,114,97,108,32,101,114,114,111,114],"value":"Structural error"}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/jsonreader.ppu


+ 9 - 0
compiler/packages/fcl-json/units/x86_64-linux/jsonreader.rsj

@@ -0,0 +1,9 @@
+{"version":1,"strings":[
+{"hash":77244558,"name":"jsonreader.serrunexpectedeof","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,69,79,70,32,101,110,99,111,117,110,116,101,114,101,100,46],"value":"Unexpected EOF encountered."},
+{"hash":171419534,"name":"jsonreader.serrunexpectedtoken","sourcebytes":[85,110,101,120,112,101,99,116,101,100,32,116,111,107,101,110,32,40,37,115,41,32,101,110,99,111,117,110,116,101,114,101,100,46],"value":"Unexpected token (%s) encountered."},
+{"hash":171025534,"name":"jsonreader.serrexpectedcolon","sourcebytes":[69,120,112,101,99,116,101,100,32,99,111,108,111,110,32,40,58,41,44,32,103,111,116,32,116,111,107,101,110,32,34,37,115,34,46],"value":"Expected colon (:), got token \"%s\"."},
+{"hash":174529602,"name":"jsonreader.serrexpectedelementname","sourcebytes":[69,120,112,101,99,116,101,100,32,101,108,101,109,101,110,116,32,110,97,109,101,44,32,103,111,116,32,116,111,107,101,110,32,34,37,115,34],"value":"Expected element name, got token \"%s\""},
+{"hash":182858430,"name":"jsonreader.sexpectedcommaorbraceclose","sourcebytes":[69,120,112,101,99,116,101,100,32,44,32,111,114,32,93,44,32,103,111,116,32,116,111,107,101,110,32,34,37,115,34,46],"value":"Expected , or ], got token \"%s\"."},
+{"hash":222938003,"name":"jsonreader.serrinvalidnumber","sourcebytes":[78,117,109,98,101,114,32,105,115,32,110,111,116,32,97,110,32,105,110,116,101,103,101,114,32,111,114,32,114,101,97,108,32,110,117,109,98,101,114,58,32,37,115],"value":"Number is not an integer or real number: %s"},
+{"hash":70947455,"name":"jsonreader.serrnoscanner","sourcebytes":[78,111,32,115,99,97,110,110,101,114,46,32,78,111,32,115,111,117,114,99,101,32,115,112,101,99,105,102,105,101,100,32,63],"value":"No scanner. No source specified ?"}
+]}

BIN
compiler/packages/fcl-json/units/x86_64-linux/jsonscanner.ppu


+ 5 - 0
compiler/packages/fcl-json/units/x86_64-linux/jsonscanner.rsj

@@ -0,0 +1,5 @@
+{"version":1,"strings":[
+{"hash":5885991,"name":"jsonscanner.serrinvalidcharacter","sourcebytes":[73,110,118,97,108,105,100,32,99,104,97,114,97,99,116,101,114,32,97,116,32,108,105,110,101,32,37,100,44,32,112,111,115,32,37,100,58,32,39,37,115,39],"value":"Invalid character at line %d, pos %d: '%s'"},
+{"hash":163695895,"name":"jsonscanner.sunterminatedcomment","sourcebytes":[85,110,116,101,114,109,105,110,97,116,101,100,32,99,111,109,109,101,110,116,32,97,116,32,108,105,110,101,32,37,100,44,32,112,111,115,32,37,100,58,32,39,37,115,39],"value":"Unterminated comment at line %d, pos %d: '%s'"},
+{"hash":127311205,"name":"jsonscanner.serropenstring","sourcebytes":[115,116,114,105,110,103,32,101,120,99,101,101,100,115,32,101,110,100,32,111,102,32,108,105,110,101],"value":"string exceeds end of line"}
+]}

+ 2561 - 0
compiler/packages/fcl-passrc/Makefile

@@ -0,0 +1,2561 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+ifeq ($(OS_SOURCE),darwin)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=fcl-passrc
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+EXEDBGEXT=.dbg
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),wasm-wasm)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
+override FPCOPT+=-Cg
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 102 - 0
compiler/packages/fcl-passrc/Makefile.fpc

@@ -0,0 +1,102 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=fcl-passrc
+version=3.3.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources and omits the location of the source-
+# files from the fpunits.cfg files.
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 24 - 0
compiler/packages/fcl-passrc/Makefile.fpc.fpcmake

@@ -0,0 +1,24 @@
+#
+#   Makefile.fpc for FCL Pascal source file parsing and writing units
+#
+
+[package]
+name=fcl-passrc
+version=3.3.1
+
+[target]
+units=pastree pscanner pparser paswrite
+rsts=pscanner pparser pastree
+
+[compiler]
+options=-S2h
+sourcedir=src
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[rules]
+.NOTPARALLEL:

+ 92 - 0
compiler/packages/fcl-passrc/examples/parsepp.pp

@@ -0,0 +1,92 @@
+{ ---------------------------------------------------------------------
+  This is a simple program to check whether fcl-passrc
+
+  ---------------------------------------------------------------------}
+
+program parsepp;
+
+{$mode objfpc}{$H+}
+ 
+uses SysUtils, Classes, PParser, PasTree;
+ 
+type
+  { We have to override abstract TPasTreeContainer methods.
+    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
+    a "real" engine. }
+  TSimpleEngine = class(TPasTreeContainer)
+  public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+ 
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Writeln(AName,' : ',AClass.ClassName,' at ',ASourceFilename,':',ASourceLinenumber);
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+end;
+ 
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+  { dummy implementation, see TFPDocEngine.FindElement for a real example }
+  Result := nil;
+end;
+ 
+Procedure Usage;
+
+begin
+  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [-h|--help] options ');
+  Writeln('-h or --help shows this help');
+  Writeln('All other options are passed as-is to the parser');
+  Halt(0);
+end;
+ 
+var
+  M: TPasModule;
+  E: TPasTreeContainer;
+  I: Integer;
+  Decls: TFPList;
+  cmdline : String;
+  
+begin
+  cmdline:='';
+  if (ParamCount=0) or (Paramstr(1)='-h') or (Paramstr(1)='--help') then
+    Usage;
+  For I:=1 to ParamCount do
+    CmdLine:=CmdLine+' '+Paramstr(i);
+  E := TSimpleEngine.Create;
+  M := nil;
+  try
+    M := ParseSource(E, cmdline, 'linux', 'i386');
+ 
+    { Cool, we successfully parsed the module.
+      Now output some info about it. }
+    if M.InterfaceSection <> nil then
+    begin
+      Decls := M.InterfaceSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Interface item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end else
+      Writeln('No interface section --- this is not a unit, this is a ', M.ClassName);
+ 
+    if M.ImplementationSection <> nil then // may be nil in case of a simple program
+    begin
+      Decls := M.ImplementationSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Implementation item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end;
+ 
+  finally
+    FreeAndNil(M);
+    FreeAndNil(E)
+  end;
+end.

+ 62 - 0
compiler/packages/fcl-passrc/examples/pasrewrite.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="pasrewrite"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-i 'tf.pp -Sd' -o tf2.pp"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="pasrewrite.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="pasrewrite"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 482 - 0
compiler/packages/fcl-passrc/examples/pasrewrite.pp

@@ -0,0 +1,482 @@
+program pasrewrite;
+
+{$mode objfpc}
+{$H+}
+
+uses SysUtils, inifiles, strutils, Classes, Pscanner,PParser, PasTree, paswrite, custapp, iostream;
+
+//# types the parser needs
+
+type
+  { We have to override abstract TPasTreeContainer methods.
+    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
+    a "real" engine. }
+  TSimpleEngine = class(TPasTreeContainer)
+  public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+
+  { TPasRewriteApplication }
+
+  TPasRewriteApplication  = Class(TCustomApplication)
+  Private
+    FHeaderFile : String;
+    FDefines : TStrings;
+    FLineNumberWidth,
+    FIndentSize : Integer;
+    FOptions : TPasWriterOptions;
+    FForwardClasses,
+    FExtraUnits,
+    cmdl,
+    ConfigFile,
+    filename,
+    TargetOS,
+    TargetCPU : string;
+    function GetModule: TPasModule;
+    procedure PrintUsage(S: String);
+    procedure ReadConfig(const aFileName: String);
+    procedure ReadConfig(const aIni: TIniFile);
+    procedure WriteModule(M: TPasModule);
+  Protected
+    function ParseOptions : Boolean;
+    Procedure DoRun; override;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  end;
+
+{ TSimpleEngine }
+
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+end;
+
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+  { dummy implementation, see TFPDocEngine.FindElement for a real example }
+  Result := nil;
+end;
+
+{ TPasRewriteApplication }
+
+procedure TPasRewriteApplication.PrintUsage(S : String);
+
+begin
+  if S<>'' then
+    Writeln('Error : ',S);
+  writeln('usage: pasrewrite options');
+  writeln;
+  writeln('Where options is one or more of');
+  writeln('-s --os=OS            Set OS, one of WINDOWS, LINUX (default), FREEBSD, NETBSD,');
+  writeln('                           SUNOS, BEOS, QNX, GO32V2');
+  writeln('-u --cpu=CPU          Set CPU = i386 (default), x86_64');
+  writeln('-x --extra=units      Comma-separated list of extra units to be added to uses list.');
+  writeln('-i --input=cmd        Is the commandline for the parser');
+  writeln('-o --output=file      Output file name. If not specified, standard output is assumed ');
+  Writeln('-t --indent=N         Number of characters for indent (default 2)');
+  Writeln('-c --config=filename  Read ini file with configuration');
+  Writeln('-H --header=filename  Add file header using contents of file "filename"');
+  Writeln('--no-implementation   Skip generation of executeable code');
+  Writeln('--no-externalclass    Skip generation of external classes (write as regular class)');
+  Writeln('--no-externalvar      Skip generation of external variables (write as regular variables)');
+  Writeln('--no-externalfunction Skip generation of external functions (write as regular functions)');
+  Writeln('-f --forwardclasses[=list]');
+  Writeln('                      Generate forward definitions for list of classes. If empty, for all classes.');
+  Writeln('-n --add-linenumber   Add linenumber to comment in front of each line');
+  Writeln('-N --add-sourcelinenumber   Add source linenumber to comment in front of each line');
+  Writeln('-w --linenumberwidth  Number of digits to pad line numbers (default 4)');
+  ExitCode:=Ord(S<>'');
+end;
+
+function TPasRewriteApplication.ParseOptions : Boolean;
+
+Var
+  S : String;
+
+begin
+  TargetOS:='linux';
+  TargetCPU:='i386';
+  FIndentSize:=-1;
+  FOptions:=[];
+  Result:=False;
+  S:=CheckOptions('d:w:fhs:u:i:o:nNt:c:x:',['help','os:','cpu:','input:','output:','indent:','define',
+                                    'no-implementation','no-externalclass',
+                                    'no-externalvar','add-linenumber','add-sourcelinenumber',
+                                    'no-externalfunction','extra:','forwardclasses::',
+                                    'config:','linenumberwidth']);
+  if (S<>'') or HasOption('h','help') then
+     begin
+     PrintUsage(S);
+     Exit;
+     end;
+  // Standard options
+  cmdl:=GetOptionValue('i','input');
+  FileName:=GetOptionValue('o','output');
+  FHeaderFile:=GetOptionValue('H','header');;
+  if HasOption('s','os') then
+    TargetOS:=GetOPtionValue('s','os');
+  if HasOption('u','cpu') then
+    TargetCPU:=GetOptionValue('u','cpu');
+  ConfigFile:=GetOptionValue('c','config');
+  FExtraUnits:=GetOptionValue('x','extra');
+  // Options
+  if Hasoption('w','linenumberwidth') then
+    FLineNumberWidth:=StrToIntDef(GetOptionValue('w','linenumberwidth'),-1);
+  if Hasoption('n','add-linenumber') then
+    Include(Foptions,woAddLineNumber);
+  if Hasoption('N','add-sourcelinenumber') then
+    Include(Foptions,woAddSourceLineNumber);
+  if Hasoption('no-implementation') then
+    Include(Foptions,woNoImplementation);
+  if Hasoption('no-externalclass') then
+    Include(Foptions,woNoExternalClass);
+  if Hasoption('no-externalvar') then
+    Include(Foptions,woNoExternalVar);
+  if Hasoption('no-externalfunction') then
+    Include(Foptions,woNoExternalFunc);
+  If HasOption('d','define') then
+    for S in GetOptionValues('d','define') do
+      FDefines.Add(S);
+  if Hasoption('f','forwardclasses') then
+    begin
+    Include(Foptions,woForwardClasses);
+    FForwardClasses:=GetOptionValue('f','forwardclasses');
+    end;
+  // Indent
+  if HasOption('t','indent') then
+    FIndentSize:=StrToIntDef(GetOptionValue('d','indent'),-1);
+  if (FHeaderFile<>'') and Not FileExists(FheaderFile) then
+    begin
+    PrintUsage(Format('Header file "%s"does not exist',[FHeaderFile]));
+    Exit;
+    end;
+  //  Check options
+  Result:=(Cmdl<>'') ;
+  If Not Result then
+    PrintUsage('Need input');
+end;
+
+{ TPasRewriteApplication }
+
+
+
+Function TPasRewriteApplication.GetModule : TPasModule;
+
+Var
+  SE : TSimpleEngine;
+  FileResolver: TFileResolver;
+  InputFileName : string;
+  Parser: TPasParser;
+  Start, CurPos: PChar;
+  Scanner: TPascalScanner;
+
+  procedure ProcessCmdLinePart;
+
+  var
+    l: Integer;
+    s: String;
+  begin
+    l := CurPos - Start;
+    SetLength(s, l);
+    if l > 0 then
+      Move(Start^, s[1], l)
+    else
+      exit;
+    if (s[1] = '-') and (length(s)>1) then
+    begin
+      case s[2] of
+        'd': // -d define
+          Scanner.AddDefine(UpperCase(Copy(s, 3, Length(s))));
+        'u': // -u undefine
+          Scanner.RemoveDefine(UpperCase(Copy(s, 3, Length(s))));
+        'F': // -F
+          if (length(s)>2) and (s[3] = 'i') then // -Fi include path
+            FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
+        'I': // -I include path
+          FileResolver.AddIncludePath(Copy(s, 3, Length(s)));
+        'S': // -S mode
+          if  (length(s)>2) then
+            begin
+            l:=3;
+            While L<=Length(S) do
+              begin
+              case S[l] of
+                'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
+                'd' : Scanner.SetCompilerMode('DELPHI');
+                '2' : Scanner.SetCompilerMode('OBJFPC');
+                'h' : ; // do nothing
+              end;
+              inc(l);
+              end;
+            end;
+        'M' :
+           begin
+           delete(S,1,2);
+           Scanner.SetCompilerMode(S);
+           end;
+      end;
+    end else
+      if InputFilename <> '' then
+        raise Exception.Create(SErrMultipleSourceFiles)
+      else
+        InputFilename := s;
+  end;
+
+
+var
+  s: String;
+
+begin
+  try
+    Result := nil;
+    FileResolver := nil;
+    Scanner := nil;
+    Parser := nil;
+    SE:=TSimpleEngine.Create;
+    try
+      FileResolver := TFileResolver.Create;
+      FileResolver.UseStreams:=True;
+      Scanner := TPascalScanner.Create(FileResolver);
+      Scanner.Options:=[po_keepclassforward,po_AsmWhole];
+      SCanner.LogEvents:=SE.ScannerLogEvents;
+      SCanner.OnLog:=SE.Onlog;
+      Scanner.AddDefine('FPK');
+      Scanner.AddDefine('FPC');
+      For S in FDefines do
+        Scanner.AddDefine(S);
+      // TargetOS
+      s := UpperCase(TargetOS);
+      Scanner.AddDefine(s);
+      if s = 'LINUX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'FREEBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'NETBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'SUNOS' then
+      begin
+        Scanner.AddDefine('SOLARIS');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'GO32V2' then
+        Scanner.AddDefine('DPMI')
+      else if s = 'BEOS' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'QNX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'AROS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'MORPHOS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'AMIGA' then
+        Scanner.AddDefine('HASAMIGA');
+
+      // TargetCPU
+      s := UpperCase(TargetCPU);
+      Scanner.AddDefine('CPU'+s);
+      if (s='X86_64') then
+        Scanner.AddDefine('CPU64')
+      else
+        Scanner.AddDefine('CPU32');
+      Parser := TPasParser.Create(Scanner, FileResolver, SE);
+      InputFilename := '';
+      Parser.LogEvents:=SE.ParserLogEvents;
+      Parser.OnLog:=SE.Onlog;
+
+      if cmdl<>'' then
+        begin
+          Start := @cmdl[1];
+          CurPos := Start;
+          while CurPos[0] <> #0 do
+          begin
+            if CurPos[0] = ' ' then
+            begin
+              ProcessCmdLinePart;
+              Start := CurPos + 1;
+            end;
+            Inc(CurPos);
+          end;
+          ProcessCmdLinePart;
+        end;
+
+      if InputFilename = '' then
+        raise Exception.Create(SErrNoSourceGiven);
+      FileResolver.AddIncludePath(ExtractFilePath(InputFileName));
+      Scanner.OpenFile(InputFilename);
+      Parser.Options:=Parser.Options+[po_AsmWhole,po_KeepClassForward];
+      Parser.ParseMain(Result);
+    finally
+      Parser.Free;
+      Scanner.Free;
+      FileResolver.Free;
+      SE.Free;
+    end;
+  except
+    on E : EParserError do
+      begin
+      writeln(E.message,' line:',E .row,' column:', E .column,' file:',E.filename);
+      end;
+    on Ex : Exception do
+      begin
+      Writeln(Ex.Message);
+      end;
+  end;
+end;
+
+procedure TPasRewriteApplication.ReadConfig(const aFileName: String);
+
+Var
+  ini : TMemIniFile;
+
+begin
+  ini:=TMemIniFile.Create(AFileName);
+  try
+    ReadConfig(Ini);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TPasRewriteApplication.ReadConfig(const aIni: TIniFile);
+
+Const
+  DelChars = [',',' '];
+
+Var
+  O : TPaswriterOptions;
+  W,S : String;
+  I : Integer;
+
+
+begin
+  O:=[];
+  With aIni do
+    begin
+    TargetOS:=ReadString('config','targetos',TargetOS);
+    TargetCPU:=ReadString('config','targetcpu',TargetCPU);
+    S:=ReadString('config','options','');
+    if (S<>'') then
+      For I:=1 to WordCount(S,DelChars) do
+        begin
+        W:=LowerCase(ExtractWord(I,S,DelChars));
+        Case w of
+         'noimplementation': Include(O,woNoImplementation);
+         'noexternalclass' : Include(O,woNoExternalClass);
+         'noexternalvar' : Include(O,woNoExternalVar);
+         'noexternalfunction' : Include(O,woNoExternalFunc);
+         'forwardclasses' : Include(O,woForwardClasses);
+         'addlinenumber': Include(O,woAddLineNumber);
+         'addsourcelinenumber': Include(O,woAddSourceLineNumber);
+        end;
+        end;
+    FOptions:=O;
+    cmdl:=ReadString('config','input',cmdl);
+    Self.filename:=ReadString('config','output',Self.filename);
+    FIndentSize:=ReadInteger('config','indentsize',FIndentSize);
+    FLineNumberWidth:=ReadInteger('config','linenumberwidth',FLineNumberWidth);
+    FExtraUnits:=ReadString('config','extra',FExtraUnits);
+    FForwardClasses:=ReadString('config','forwardclasses',FForwardClasses);
+    S:=ReadString('config','defines','');
+    if (S<>'') then
+      For I:=1 to WordCount(S,DelChars) do
+        FDefines.Add(UpperCase(ExtractWord(I,S,DelChars)));
+    if (FForwardClasses<>'') then
+      Include(O,woForwardClasses);
+    end;
+end;
+
+procedure TPasRewriteApplication.WriteModule(M : TPAsModule);
+
+Var
+  F,H : TStream;
+  W : TPasWriter;
+
+begin
+  W:=Nil;
+  if FileName='' then
+    F:=TIOStream.Create(iosOutPut)
+  else
+    F:=TFileStream.Create(FileName,fmCreate);
+  try
+     if (FHeaderFile<>'') then
+       begin
+       H:=TFileStream.Create(FHeaderFile,fmOpenRead or fmShareDenyWrite);
+       try
+         F.CopyFrom(H,H.Size);
+       finally
+         H.Free;
+       end;
+       end;
+     W:=TPasWriter.Create(F);
+     W.Options:=FOptions;
+     W.ExtraUnits:=FExtraUnits;
+     if FIndentSize<>-1 then
+       W.IndentSize:=FIndentSize;
+     if FLineNumberWidth>0 then
+       W.LineNumberWidth:=FLineNumberWidth;
+     W.ForwardClasses.CommaText:=FForwardClasses;
+     W.WriteModule(M);
+  finally
+    W.Free;
+    F.Free;
+  end;
+end;
+
+procedure TPasRewriteApplication.DoRun;
+
+Var
+  M: TPasModule;
+
+begin
+  Terminate;
+  TargetOS:='linux';
+  TargetCPU:='i386';
+  If not ParseOptions then
+    exit;
+  If (ConfigFile<>'') then
+    ReadConfig(ConfigFile);
+  M:=GetModule;
+  if M=Nil then
+    exit;
+  try
+    WriteModule(M);
+  finally
+    M.Free;
+  end;
+end;
+
+constructor TPasRewriteApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDefines:=TStringList.Create;
+
+end;
+
+destructor TPasRewriteApplication.Destroy;
+begin
+  FreeAndNil(FDefines);
+  inherited Destroy;
+end;
+
+Var
+  Application : TPasRewriteApplication;
+
+begin
+  Application:=TPasRewriteApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

이 변경점에서 너무 많은 파일들이 변경되어 몇몇 파일들은 표시되지 않았습니다.