diff --git a/.gitignore b/.gitignore
index 1280fb74b6358d88d5bc8c8d488d981b1569472f..c4204e5ff6e7981f0a1fa70898438580dd785939 100644
--- a/.gitignore
+++ b/.gitignore
@@ -55,6 +55,7 @@ autom4te.cache
/tests/journal/intra.byte
/tests/misc/my_visitor_plugin/my_visitor.opt
/tests/misc/my_visitor.sav
+/tests/spec/preprocess_dos.c
/tests/*/*.opt
/tests/pdg/*.dot
@@ -92,6 +93,8 @@ autom4te.cache
/doc/acsl/
+/doc/aorai/aorai-example.tgz
+/doc/aorai/aorai-example/
/doc/aorai/frama-c-aorai-example.tgz
/doc/aorai/frama-c-aorai-example
/doc/aorai/main.pdf
diff --git a/INSTALL.md b/INSTALL.md
index 7bcad1826848efaa043e1ebc82415d7aee36b94b..d5eccd8b61e99690fb77505f710808b5f03195a1 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -41,7 +41,7 @@ macOS has opam through Homebrew.
Windows users can install opam via WSL (Windows Subsystem for Linux).
If your system does not have an opam package >= 2.0.0, you can
-[compile it from source]((#compiling-from-source)),
+[compile it from source](#compiling-from-source),
or use the provided opam binaries available at:
http://opam.ocaml.org/doc/Install.html
diff --git a/Makefile b/Makefile
index 39a52389bc1ae46a2bb3020873eb27f68062444c..8bd4ad0cf6397d041cdf7844e9b2450d3b6c0c64 100644
--- a/Makefile
+++ b/Makefile
@@ -911,6 +911,7 @@ PLUGIN_CMO:= partitioning/split_strategy domains/domain_mode value_parameters \
engine/mem_exec engine/iterator engine/initialization \
engine/compute_functions engine/analysis register \
api/general_requests \
+ utils/unit_tests \
$(APRON_CMO) $(NUMERORS_CMO)
PLUGIN_CMI:= values/abstract_value values/abstract_location \
domains/abstract_domain domains/simpler_domains
@@ -2339,7 +2340,29 @@ PTESTS_SRC=ptests/ptests_config.ml ptests/ptests.ml
# that does not contain a 'tests' dir
PTESTS_CONFIG:= $(shell if test -d tests; then echo tests/ptests_config; fi)
-ptests: bin/ptests.$(OCAMLBEST)$(EXE) $(PTESTS_CONFIG)
+ifneq ("$(PTESTS_CONFIG)","")
+GENERATED_TESTS:=tests/spec/preprocess_dos.c
+else
+GENERATED_TESTS:=
+endif
+
+tests/spec/preprocess_dos.c: tests/spec/preprocess_dos.c.in \
+ Makefile share/Makefile.config
+ $(RM) $@
+ $(SED) -e "s|@UNIX2DOS@|$(PP_DOS_UNIX2DOS)|g" \
+ -e "s|@DONTRUN@|$(PP_DOS_DONTRUN)|g" \
+ $< > $@
+ $(CHMOD_RO) $@
+
+ifneq ("$(HAS_UNIX2DOS)","no")
+tests/spec/preprocess_dos.c: PP_DOS_UNIX2DOS=$(UNIX2DOS)
+tests/spec/preprocess_dos.c: PP_DOS_DONTRUN=
+else
+tests/spec/preprocess_dos.c: PP_DOS_UNIX2DOS=unix2dos
+tests/spec/preprocess_dos.c: PP_DOS_DONTRUN=DONTRUN: no unix2dos found
+endif
+
+ptests: bin/ptests.$(OCAMLBEST)$(EXE) $(PTESTS_CONFIG) $(GENERATED_TESTS)
bin/ptests.byte$(EXE): $(PTESTS_SRC)
$(PRINT_LINKING) $@
@@ -2351,7 +2374,7 @@ bin/ptests.opt$(EXE): $(PTESTS_SRC)
$(OCAMLOPT) -I ptests -dtypes -thread -o $@ \
unix.cmxa threads.cmxa str.cmxa dynlink.cmxa $^
-GENERATED+=ptests/ptests_config.ml tests/ptests_config
+GENERATED+=ptests/ptests_config.ml tests/ptests_config $(GENERATED_TESTS)
#######################
# Source distribution #
diff --git a/bin/wp-qualif.sh b/bin/wp-qualif.sh
new file mode 100644
index 0000000000000000000000000000000000000000..ae239fbadbe2bcd440bac1a4cd149dcc391e1d13
--- /dev/null
+++ b/bin/wp-qualif.sh
@@ -0,0 +1,2 @@
+export FRAMAC_WP_CACHE=update
+export FRAMAC_WP_CACHEDIR=$WP_QUALIF_CACHE
diff --git a/configure.in b/configure.in
index 284e9f5cea3280ba307aa6962ea4ad07f207f5ca..364940906cb9c955115ee9d81cca18b36168df30 100644
--- a/configure.in
+++ b/configure.in
@@ -657,14 +657,6 @@ REQUIRE_LABLGTK=
USE_LABLGTK=
HAS_LABLGTK=
-# Tool declarations
-####################
-
-DOT=
-REQUIRE_DOT=
-USE_DOT=
-HAS_DOT=
-
### Now plugin declarations
PLUGINS_FORCE_LIST=
@@ -957,6 +949,11 @@ configure_library([LABLGTK],
configure_tool([DOT],[dot],[dot not found: you should install GraphViz],no)
+configure_tool([UNIX2DOS],[unix2dos],
+ [unix2dos not found: you should install tofrodos],no)
+
+plugin_use_external(tests,unix2dos)
+
########################
# Plug-in dependencies #
########################
@@ -974,8 +971,6 @@ EXTERNAL_PLUGINS="${EXTERNAL_PLUGINS} ${EXTRA_EXTERNAL_PLUGINS}"
AC_SUBST(PLATFORM)
AC_SUBST(VERBOSEMAKE)
AC_SUBST(DEVELOPMENT)
-AC_SUBST(DOT)
-AC_SUBST(HAS_DOT)
AC_SUBST(HAS_APRON)
AC_SUBST(HAS_MPFR)
AC_SUBST(HAS_LANDMARKS)
diff --git a/devel_tools/docker/README.md b/devel_tools/docker/README.md
new file mode 100644
index 0000000000000000000000000000000000000000..0a1c8e049e40b74e21466ee9b87be75a27475901
--- /dev/null
+++ b/devel_tools/docker/README.md
@@ -0,0 +1,29 @@
+Docker images for Frama-C
+=========================
+
+- To build a new image (slim, without Frama-C sources nor tests):
+
+ cd <tag>
+ docker build . --target base -t framac/frama-c:<tag>
+
+- To run an interactive shell:
+
+ docker run -it framac/frama-c:<tag>
+
+- To push to Docker Hub (requires access to the `framac/frama-c` repository):
+
+ docker push framac/frama-c:<tag>
+
+- To build an image containing Frama-C sources (downloaded from the .tar.gz, in
+ directory `/root`):
+
+ cd <tag>
+ docker build . --build-arg with_source=yes \
+ -t framac/frama-c:<tag>-with-source
+
+- To run Frama-C tests (and remove unnecessary image later):
+
+ cd <tag>
+ docker build . --build-arg with_source=yes --build-arg with_test=yes \
+ -t framac/frama-c:<tag>-with-test
+ docker image rm framac/frama-c:<tag>-with-test
diff --git a/devel_tools/docker/frama-c.20.0/Dockerfile b/devel_tools/docker/frama-c.20.0/Dockerfile
new file mode 100644
index 0000000000000000000000000000000000000000..d73738fb95080d205a3c8a6668c246dbd41ca1a7
--- /dev/null
+++ b/devel_tools/docker/frama-c.20.0/Dockerfile
@@ -0,0 +1,58 @@
+FROM debian:sid as base
+
+RUN apt update
+RUN apt install opam -y
+RUN opam init --disable-sandboxing --compiler=ocaml-base-compiler.4.05.0 -y
+
+# "RUN eval $(opam env)" does not work, so we manually set its variables
+ENV OPAM_SWITCH_PREFIX "/root/.opam/ocaml-base-compiler.4.05.0"
+ENV CAML_LD_LIBRARY_PATH "/root/.opam/ocaml-base-compiler.4.05.0/lib/stublibs:/root/.opam/ocaml-base-compiler.4.05.0/lib/ocaml/stublibs:/root/.opam/ocaml-base-compiler.4.05.0/lib/ocaml"
+ENV OCAML_TOPLEVEL_PATH "/root/.opam/ocaml-base-compiler.4.05.0/lib/toplevel"
+ENV MANPATH "$MANPATH:/root/.opam/ocaml-base-compiler.4.05.0/man"
+ENV PATH "/root/.opam/ocaml-base-compiler.4.05.0/bin:$PATH"
+
+RUN opam update -y
+RUN opam install depext -y
+
+# Install packages from reference configuration
+RUN opam depext --install -y \
+ alt-ergo.2.0.0 \
+ apron.20160125 \
+ conf-graphviz.0.1 \
+ mlgmpidl.1.2.11 \
+ ocamlfind.1.8.0 \
+ ocamlgraph.1.8.8 \
+ ppx_deriving_yojson.3.5.2 \
+ why3.1.2.0 \
+ yojson.1.7.0 \
+ zarith.1.9.1 \
+ --verbose # intentionally left as last line in this RUN command
+RUN why3 config --detect-provers
+
+# with_source: keep Frama-C sources
+ARG with_source=no
+
+RUN cd /root && \
+ wget http://frama-c.com/download/frama-c-20.0-Calcium.tar.gz && \
+ tar xvf frama-c-*.tar.gz && \
+ (cd frama-c-* && \
+ ./configure --disable-gui && \
+ make -j && \
+ make install \
+ ) && \
+ rm -f frama-c-*.tar.gz && \
+ [ "${with_source}" != "no" ] || rm -rf frama-c-*
+
+# with_test: run Frama-C tests; requires "with_source=yes"
+ARG with_test=no
+
+RUN if [ "${with_test}" != "no" ]; then \
+ opam depext --install -y \
+ conf-python-3.1.0.0 \
+ conf-time.1 \
+ --verbose \
+ && \
+ apt install python -y && \
+ cd /root/frama-c-* && \
+ make tests; \
+ fi
diff --git a/devel_tools/docker/frama-c.21.0/Dockerfile b/devel_tools/docker/frama-c.21.0/Dockerfile
new file mode 100644
index 0000000000000000000000000000000000000000..3a615a7bf0f9d87ec211b428dd12891c3ea4c57d
--- /dev/null
+++ b/devel_tools/docker/frama-c.21.0/Dockerfile
@@ -0,0 +1,58 @@
+FROM debian:sid as base
+
+RUN apt update
+RUN apt install opam -y
+RUN opam init --disable-sandboxing --compiler=ocaml-base-compiler.4.07.1 -y
+
+# "RUN eval $(opam env)" does not work, so we manually set its variables
+ENV OPAM_SWITCH_PREFIX "/root/.opam/ocaml-base-compiler.4.07.1"
+ENV CAML_LD_LIBRARY_PATH "/root/.opam/ocaml-base-compiler.4.07.1/lib/stublibs:/root/.opam/ocaml-base-compiler.4.07.1/lib/ocaml/stublibs:/root/.opam/ocaml-base-compiler.4.07.1/lib/ocaml"
+ENV OCAML_TOPLEVEL_PATH "/root/.opam/ocaml-base-compiler.4.07.1/lib/toplevel"
+ENV MANPATH "$MANPATH:/root/.opam/ocaml-base-compiler.4.07.1/man"
+ENV PATH "/root/.opam/ocaml-base-compiler.4.07.1/bin:$PATH"
+
+RUN opam update -y
+RUN opam install depext -y
+
+# Install packages from reference configuration
+RUN opam depext --install -y \
+ alt-ergo.2.0.0 \
+ apron.v0.9.12 \
+ conf-graphviz.0.1 \
+ mlgmpidl.1.2.12 \
+ ocamlfind.1.8.0 \
+ ocamlgraph.1.8.8 \
+ ppx_deriving_yojson.3.5.2 \
+ why3.1.3.1 \
+ yojson.1.7.0 \
+ zarith.1.9.1 \
+ zmq.5.1.3 \
+ --verbose # intentionally left as last line in this RUN command
+RUN why3 config --full-config
+
+# with_source: keep Frama-C sources
+ARG with_source=no
+
+RUN cd /root && \
+ wget http://frama-c.com/download/frama-c-21.0-Scandium.tar.gz && \
+ tar xvf frama-c-*.tar.gz && \
+ (cd frama-c-* && \
+ ./configure --disable-gui && \
+ make -j && \
+ make install \
+ ) && \
+ rm -f frama-c-*.tar.gz && \
+ [ "${with_source}" != "no" ] || rm -rf frama-c-*
+
+# with_test: run Frama-C tests; requires "with_source=yes"
+ARG with_test=no
+
+RUN if [ "${with_test}" != "no" ]; then \
+ opam depext --install -y \
+ conf-python-3.1.0.0 \
+ conf-time.1 \
+ --verbose \
+ && \
+ cd /root/frama-c-* && \
+ make tests; \
+ fi
diff --git a/devel_tools/docker/frama-c.21.1/Dockerfile b/devel_tools/docker/frama-c.21.1/Dockerfile
new file mode 100644
index 0000000000000000000000000000000000000000..8852ac14805bad7b5862b8b1205a5e667ab8ca8c
--- /dev/null
+++ b/devel_tools/docker/frama-c.21.1/Dockerfile
@@ -0,0 +1,58 @@
+FROM debian:sid as base
+
+RUN apt update
+RUN apt install opam -y
+RUN opam init --disable-sandboxing --compiler=ocaml-base-compiler.4.07.1 -y
+
+# "RUN eval $(opam env)" does not work, so we manually set its variables
+ENV OPAM_SWITCH_PREFIX "/root/.opam/ocaml-base-compiler.4.07.1"
+ENV CAML_LD_LIBRARY_PATH "/root/.opam/ocaml-base-compiler.4.07.1/lib/stublibs:/root/.opam/ocaml-base-compiler.4.07.1/lib/ocaml/stublibs:/root/.opam/ocaml-base-compiler.4.07.1/lib/ocaml"
+ENV OCAML_TOPLEVEL_PATH "/root/.opam/ocaml-base-compiler.4.07.1/lib/toplevel"
+ENV MANPATH "$MANPATH:/root/.opam/ocaml-base-compiler.4.07.1/man"
+ENV PATH "/root/.opam/ocaml-base-compiler.4.07.1/bin:$PATH"
+
+RUN opam update -y
+RUN opam install depext -y
+
+# Install packages from reference configuration
+RUN opam depext --install -y \
+ alt-ergo.2.0.0 \
+ apron.v0.9.12 \
+ conf-graphviz.0.1 \
+ mlgmpidl.1.2.12 \
+ ocamlfind.1.8.0 \
+ ocamlgraph.1.8.8 \
+ ppx_deriving_yojson.3.5.2 \
+ why3.1.3.1 \
+ yojson.1.7.0 \
+ zarith.1.9.1 \
+ zmq.5.1.3 \
+ --verbose # intentionally left as last line in this RUN command
+RUN why3 config --full-config
+
+# with_source: keep Frama-C sources
+ARG with_source=no
+
+RUN cd /root && \
+ wget http://frama-c.com/download/frama-c-21.1-Scandium.tar.gz && \
+ tar xvf frama-c-*.tar.gz && \
+ (cd frama-c-* && \
+ ./configure --disable-gui && \
+ make -j && \
+ make install \
+ ) && \
+ rm -f frama-c-*.tar.gz && \
+ [ "${with_source}" != "no" ] || rm -rf frama-c-*
+
+# with_test: run Frama-C tests; requires "with_source=yes"
+ARG with_test=no
+
+RUN if [ "${with_test}" != "no" ]; then \
+ opam depext --install -y \
+ conf-python-3.1.0.0 \
+ conf-time.1 \
+ --verbose \
+ && \
+ cd /root/frama-c-* && \
+ make tests; \
+ fi
diff --git a/doc/developer/advance.tex b/doc/developer/advance.tex
index 956eda16413b10e71b1d45b1882db9669098ee23..91c8e28c36120e62de749eac8174f2c34f15399a 100644
--- a/doc/developer/advance.tex
+++ b/doc/developer/advance.tex
@@ -1020,9 +1020,7 @@ directory of directory \texttt{tests}\codeidx{tests}. The
\texttt{DONTRUN} directive does not need to have any content, but it
is useful to provide an explanation of why the test should not be run
({\it e.g} test of a feature that is currently developed and not fully
-operational yet). If a test file is explicitly given on the command
-line of \ptests, it is always executed, regardless of the presence of
-a \texttt{DONTRUN} directive.
+operational yet).
As said in Section~\ref{ptests:configuration}, these directives can be
found in different places:
diff --git a/doc/pandoc/style.css b/doc/pandoc/style.css
index 866aafb08dc81699fc86e6d931044bd2317ddf59..919e36dfa80e952c4fb5ac636e3d7bd7a1d4c7f8 100644
--- a/doc/pandoc/style.css
+++ b/doc/pandoc/style.css
@@ -88,7 +88,7 @@ body {
#NAVIGATION a.root {
display: block;
font-family: "Optima", "Verdana", "Arial", sans;
- font-size: 10pt;
+ font-size: 16pt;
margin-top: 1cm;
margin-bottom: 6mm;
}
@@ -105,13 +105,23 @@ body {
}
#NAVIGATION ul {
- width: 6cm ;
+ width: 8cm ;
+ margin: 0px ;
+ padding: 0px ;
+}
+
+#NAVIGATION li {
+ list-style-type: none;
+ margin: 0px;
+ padding-left: 8px;
}
-#NAVIGATION ul > ul {
- margin-left: 0px ;
- padding-top: 2px ;
- padding-bottom: 2px ;
+#TOC > a {
+ font-weight: bold;
+}
+
+.TOC > ul > li > a {
+ font-weight: bold;
}
/* -------------------------------------------------------------------------- */
diff --git a/doc/pandoc/template.html b/doc/pandoc/template.html
index e6871d568e832f49fc1bcaadb8171df7a7f47b0b..d9b158d0ca3f34b9a9776fe41cd0e3075354beef 100644
--- a/doc/pandoc/template.html
+++ b/doc/pandoc/template.html
@@ -23,7 +23,7 @@
$if(toc)$
$for(link)$
$if(link.toc)$
- $table-of-contents$
+ <div class="TOC">$table-of-contents$</div>
$else$
<li><a href="$link.href$.html">$link.title$</a></li>
$endif$
diff --git a/headers/header_spec.txt b/headers/header_spec.txt
index 8a032485fce6ce08f2de54271969660573acd3e6..2be7f72a6f4d3f782c010aa8775235e2dc469548 100644
--- a/headers/header_spec.txt
+++ b/headers/header_spec.txt
@@ -1112,8 +1112,6 @@ src/plugins/server/Server.mli: .ignore
src/plugins/server/configure.ac: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/data.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/data.mli: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/doc.ml: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/doc.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/jbuffer.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/jbuffer.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/kernel_ast.ml: CEA_LGPL_OR_PROPRIETARY
@@ -1126,16 +1124,18 @@ src/plugins/server/kernel_properties.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/kernel_properties.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/main.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/main.mli: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/package.ml: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/package.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/request.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/request.mli: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/server_doc.ml: CEA_LGPL_OR_PROPRIETARY
+src/plugins/server/server_doc.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/server_parameters.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/server_parameters.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/server_batch.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/server_zmq.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/states.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/server/states.mli: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/syntax.ml: CEA_LGPL_OR_PROPRIETARY
-src/plugins/server/syntax.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/scope/Scope.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/scope/datascope.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/scope/datascope.mli: CEA_LGPL_OR_PROPRIETARY
@@ -1369,6 +1369,8 @@ src/plugins/value/utils/state_import.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/state_import.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/structure.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/structure.mli: CEA_LGPL_OR_PROPRIETARY
+src/plugins/value/utils/unit_tests.ml: CEA_LGPL_OR_PROPRIETARY
+src/plugins/value/utils/unit_tests.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/value_perf.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/value_perf.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/value/utils/value_results.ml: CEA_LGPL_OR_PROPRIETARY
@@ -1451,6 +1453,8 @@ src/plugins/wp/.gitignore: .ignore
src/plugins/wp/.ocp-indent: .ignore
src/plugins/wp/Auto.ml: CEA_WP
src/plugins/wp/Auto.mli: CEA_WP
+src/plugins/wp/Cache.ml: CEA_WP
+src/plugins/wp/Cache.mli: CEA_WP
src/plugins/wp/Cfloat.ml: CEA_WP
src/plugins/wp/Cfloat.mli: CEA_WP
src/plugins/wp/Changelog: .ignore
diff --git a/ivette/.dome-pkg-app.lock b/ivette/.dome-pkg-app.lock
index 7282f0cc447a1caf3cb155d03008966d7b2f41ab..f9677904486a71fb448d4a6db632128c0d3013ac 100644
--- a/ivette/.dome-pkg-app.lock
+++ b/ivette/.dome-pkg-app.lock
@@ -1 +1 @@
-react@^16.8 react-dom source-map-support lodash react-virtualized react-draggable codemirror
+react@^16.8 react-dom source-map-support lodash react-virtualized react-draggable react-fast-compare codemirror
diff --git a/ivette/.gitignore b/ivette/.gitignore
index da037a9e2fa9fa6eb676dcadabf0f8486c4b79bf..194fc7ea7ce2c5c7ffb30e127542107772220cd0 100644
--- a/ivette/.gitignore
+++ b/ivette/.gitignore
@@ -2,6 +2,7 @@
# --- Template .gitignore file for Dome
# --------------------------------------------------------------------------
+.ivette
.dome-*.stamp
.dome-*.back
node_modules
diff --git a/ivette/Makefile b/ivette/Makefile
index 37b317bdb838c21533eadc55362800d1c48e92c4..a9ec5f1eaebf64972c184c45a04a6ca087c11d26 100644
--- a/ivette/Makefile
+++ b/ivette/Makefile
@@ -30,6 +30,18 @@ fixlint: dome-pkg dome-templ
tsc: typecheck fixlint
+# --------------------------------------------------------------------------
+# --- Frama-C API
+# --------------------------------------------------------------------------
+
+.PHONY: api
+
+api:
+ @echo "[Ivette] Generating TypeScript API"
+ @find api -name "*.ts" -exec rm -f {} \;
+ ../bin/frama-c.byte -load-module api/server_tsc.ml -server-tsc
+ @find api -name "*.ts" -exec chmod a-w {} \;
+
# --------------------------------------------------------------------------
# --- Ivette Documentation
# --------------------------------------------------------------------------
diff --git a/ivette/api/kernel/ast/index.ts b/ivette/api/kernel/ast/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..de80989542113aa4076da348fa21c16c2df11344
--- /dev/null
+++ b/ivette/api/kernel/ast/index.ts
@@ -0,0 +1,324 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Ast Services
+ @packageDocumentation
+ @module api/kernel/ast
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+//@ts-ignore
+import { byTag } from 'api/kernel/data';
+//@ts-ignore
+import { byText } from 'api/kernel/data';
+//@ts-ignore
+import { jTag } from 'api/kernel/data';
+//@ts-ignore
+import { jTagSafe } from 'api/kernel/data';
+//@ts-ignore
+import { jText } from 'api/kernel/data';
+//@ts-ignore
+import { jTextSafe } from 'api/kernel/data';
+//@ts-ignore
+import { tag } from 'api/kernel/data';
+//@ts-ignore
+import { text } from 'api/kernel/data';
+
+const compute_internal: Server.ExecRequest<null,null> = {
+ kind: Server.RqKind.EXEC,
+ name: 'kernel.ast.compute',
+ input: Json.jNull,
+ output: Json.jNull,
+};
+/** Ensures that AST is computed */
+export const compute: Server.ExecRequest<null,null>= compute_internal;
+
+/** Marker kind */
+export enum markerKind {
+ /** Variable */
+ variable = 'variable',
+ /** Function */
+ function = 'function',
+ /** Expression */
+ expression = 'expression',
+ /** Lvalue */
+ lvalue = 'lvalue',
+ /** Declaration */
+ declaration = 'declaration',
+ /** Statement */
+ statement = 'statement',
+ /** Global */
+ global = 'global',
+ /** Term */
+ term = 'term',
+ /** Property */
+ property = 'property',
+}
+
+/** Loose decoder for `markerKind` */
+export const jMarkerKind: Json.Loose<markerKind> = Json.jEnum(markerKind);
+
+/** Safe decoder for `markerKind` */
+export const jMarkerKindSafe: Json.Safe<markerKind> =
+ Json.jFail(Json.jEnum(markerKind),'kernel.ast.markerKind expected');
+
+/** Natural order for `markerKind` */
+export const byMarkerKind: Compare.Order<markerKind> =
+ Compare.byEnum(markerKind);
+
+const markerKindTags_internal: Server.GetRequest<null,tag[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.markerKindTags',
+ input: Json.jNull,
+ output: Json.jList(jTag),
+};
+/** Registered tags for the above type. */
+export const markerKindTags: Server.GetRequest<null,tag[]>= markerKindTags_internal;
+
+/** Data for array rows [`markerInfo`](#markerinfo) */
+export interface markerInfoData {
+ /** Entry identifier. */
+ key: Json.key<'#markerInfo'>;
+ /** Marker kind */
+ kind: markerKind;
+ /** Marker short name */
+ name: string;
+ /** Marker declaration or description */
+ descr: string;
+}
+
+/** Loose decoder for `markerInfoData` */
+export const jMarkerInfoData: Json.Loose<markerInfoData> =
+ Json.jObject({
+ key: Json.jFail(Json.jKey<'#markerInfo'>('#markerInfo'),
+ '#markerInfo expected'),
+ kind: jMarkerKindSafe,
+ name: Json.jFail(Json.jString,'String expected'),
+ descr: Json.jFail(Json.jString,'String expected'),
+ });
+
+/** Safe decoder for `markerInfoData` */
+export const jMarkerInfoDataSafe: Json.Safe<markerInfoData> =
+ Json.jFail(jMarkerInfoData,'MarkerInfoData expected');
+
+/** Natural order for `markerInfoData` */
+export const byMarkerInfoData: Compare.Order<markerInfoData> =
+ Compare.byFields
+ <{ key: Json.key<'#markerInfo'>, kind: markerKind, name: string,
+ descr: string }>({
+ key: Compare.primitive,
+ kind: byMarkerKind,
+ name: Compare.alpha,
+ descr: Compare.primitive,
+ });
+
+/** Signal for array [`markerInfo`](#markerinfo) */
+export const signalMarkerInfo: Server.Signal = {
+ name: 'kernel.ast.signalMarkerInfo',
+};
+
+const reloadMarkerInfo_internal: Server.GetRequest<null,null> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.reloadMarkerInfo',
+ input: Json.jNull,
+ output: Json.jNull,
+};
+/** Force full reload for array [`markerInfo`](#markerinfo) */
+export const reloadMarkerInfo: Server.GetRequest<null,null>= reloadMarkerInfo_internal;
+
+const fetchMarkerInfo_internal: Server.GetRequest<
+ number,
+ { pending: number, updated: markerInfoData[],
+ removed: Json.key<'#markerInfo'>[], reload: boolean }
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.fetchMarkerInfo',
+ input: Json.jNumber,
+ output: Json.jObject({
+ pending: Json.jFail(Json.jNumber,'Number expected'),
+ updated: Json.jList(jMarkerInfoData),
+ removed: Json.jList(Json.jKey<'#markerInfo'>('#markerInfo')),
+ reload: Json.jFail(Json.jBoolean,'Boolean expected'),
+ }),
+};
+/** Data fetcher for array [`markerInfo`](#markerinfo) */
+export const fetchMarkerInfo: Server.GetRequest<
+ number,
+ { pending: number, updated: markerInfoData[],
+ removed: Json.key<'#markerInfo'>[], reload: boolean }
+ >= fetchMarkerInfo_internal;
+
+const markerInfo_internal: State.Array<
+ Json.key<'#markerInfo'>,
+ markerInfoData
+ > = {
+ name: 'kernel.ast.markerInfo',
+ getkey: ((d:markerInfoData) => d.key),
+ signal: signalMarkerInfo,
+ fetch: fetchMarkerInfo,
+ reload: reloadMarkerInfo,
+ order: byMarkerInfoData,
+};
+/** Marker informations */
+export const markerInfo: State.Array<Json.key<'#markerInfo'>,markerInfoData> = markerInfo_internal;
+
+/** Localizable AST markers */
+export type marker =
+ Json.key<'#stmt'> | Json.key<'#decl'> | Json.key<'#lval'> |
+ Json.key<'#expr'> | Json.key<'#term'> | Json.key<'#global'> |
+ Json.key<'#property'>;
+
+/** Loose decoder for `marker` */
+export const jMarker: Json.Loose<marker> =
+ Json.jUnion<Json.key<'#stmt'> | Json.key<'#decl'> | Json.key<'#lval'> |
+ Json.key<'#expr'> | Json.key<'#term'> | Json.key<'#global'> |
+ Json.key<'#property'>>(
+ Json.jKey<'#stmt'>('#stmt'),
+ Json.jKey<'#decl'>('#decl'),
+ Json.jKey<'#lval'>('#lval'),
+ Json.jKey<'#expr'>('#expr'),
+ Json.jKey<'#term'>('#term'),
+ Json.jKey<'#global'>('#global'),
+ Json.jKey<'#property'>('#property'),
+ );
+
+/** Safe decoder for `marker` */
+export const jMarkerSafe: Json.Safe<marker> =
+ Json.jFail(jMarker,'Marker expected');
+
+/** Natural order for `marker` */
+export const byMarker: Compare.Order<marker> = Compare.structural;
+
+const getFunctions_internal: Server.GetRequest<null,Json.key<'#fct'>[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.getFunctions',
+ input: Json.jNull,
+ output: Json.jList(Json.jKey<'#fct'>('#fct')),
+};
+/** Collect all functions in the AST */
+export const getFunctions: Server.GetRequest<null,Json.key<'#fct'>[]>= getFunctions_internal;
+
+const printFunction_internal: Server.GetRequest<Json.key<'#fct'>,text> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.printFunction',
+ input: Json.jKey<'#fct'>('#fct'),
+ output: jText,
+};
+/** Print the AST of a function */
+export const printFunction: Server.GetRequest<Json.key<'#fct'>,text>= printFunction_internal;
+
+/** Data for array rows [`functions`](#functions) */
+export interface functionsData {
+ /** Entry identifier. */
+ key: Json.key<'#functions'>;
+ /** Name */
+ name: string;
+ /** Signature */
+ signature: string;
+}
+
+/** Loose decoder for `functionsData` */
+export const jFunctionsData: Json.Loose<functionsData> =
+ Json.jObject({
+ key: Json.jFail(Json.jKey<'#functions'>('#functions'),
+ '#functions expected'),
+ name: Json.jFail(Json.jString,'String expected'),
+ signature: Json.jFail(Json.jString,'String expected'),
+ });
+
+/** Safe decoder for `functionsData` */
+export const jFunctionsDataSafe: Json.Safe<functionsData> =
+ Json.jFail(jFunctionsData,'FunctionsData expected');
+
+/** Natural order for `functionsData` */
+export const byFunctionsData: Compare.Order<functionsData> =
+ Compare.byFields
+ <{ key: Json.key<'#functions'>, name: string, signature: string }>({
+ key: Compare.primitive,
+ name: Compare.alpha,
+ signature: Compare.primitive,
+ });
+
+/** Signal for array [`functions`](#functions) */
+export const signalFunctions: Server.Signal = {
+ name: 'kernel.ast.signalFunctions',
+};
+
+const reloadFunctions_internal: Server.GetRequest<null,null> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.reloadFunctions',
+ input: Json.jNull,
+ output: Json.jNull,
+};
+/** Force full reload for array [`functions`](#functions) */
+export const reloadFunctions: Server.GetRequest<null,null>= reloadFunctions_internal;
+
+const fetchFunctions_internal: Server.GetRequest<
+ number,
+ { pending: number, updated: functionsData[],
+ removed: Json.key<'#functions'>[], reload: boolean }
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.fetchFunctions',
+ input: Json.jNumber,
+ output: Json.jObject({
+ pending: Json.jFail(Json.jNumber,'Number expected'),
+ updated: Json.jList(jFunctionsData),
+ removed: Json.jList(Json.jKey<'#functions'>('#functions')),
+ reload: Json.jFail(Json.jBoolean,'Boolean expected'),
+ }),
+};
+/** Data fetcher for array [`functions`](#functions) */
+export const fetchFunctions: Server.GetRequest<
+ number,
+ { pending: number, updated: functionsData[],
+ removed: Json.key<'#functions'>[], reload: boolean }
+ >= fetchFunctions_internal;
+
+const functions_internal: State.Array<Json.key<'#functions'>,functionsData> = {
+ name: 'kernel.ast.functions',
+ getkey: ((d:functionsData) => d.key),
+ signal: signalFunctions,
+ fetch: fetchFunctions,
+ reload: reloadFunctions,
+ order: byFunctionsData,
+};
+/** AST Functions */
+export const functions: State.Array<Json.key<'#functions'>,functionsData> = functions_internal;
+
+const getInfo_internal: Server.GetRequest<marker,text> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.getInfo',
+ input: jMarker,
+ output: jText,
+};
+/** Get textual information about a marker */
+export const getInfo: Server.GetRequest<marker,text>= getInfo_internal;
+
+const getFiles_internal: Server.GetRequest<null,string[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.ast.getFiles',
+ input: Json.jNull,
+ output: Json.jList(Json.jString),
+};
+/** Get the currently analyzed source file names */
+export const getFiles: Server.GetRequest<null,string[]>= getFiles_internal;
+
+const setFiles_internal: Server.SetRequest<string[],null> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.ast.setFiles',
+ input: Json.jList(Json.jString),
+ output: Json.jNull,
+};
+/** Set the source file names to analyze. */
+export const setFiles: Server.SetRequest<string[],null>= setFiles_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/kernel/data/index.ts b/ivette/api/kernel/data/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..ffd93535e849479a40c0683f83c6bdf65ed6c5fe
--- /dev/null
+++ b/ivette/api/kernel/data/index.ts
@@ -0,0 +1,74 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Informations
+ @packageDocumentation
+ @module api/kernel/data
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+
+/** Markdown (inlined) text. */
+export type markdown = string;
+
+/** Loose decoder for `markdown` */
+export const jMarkdown: Json.Loose<markdown> = Json.jString;
+
+/** Safe decoder for `markdown` */
+export const jMarkdownSafe: Json.Safe<markdown> =
+ Json.jFail(Json.jString,'String expected');
+
+/** Natural order for `markdown` */
+export const byMarkdown: Compare.Order<markdown> = Compare.primitive;
+
+/** Rich text format uses `[tag; …text ]` to apply the tag `tag` to the enclosed text. Empty tag `""` can also used to simply group text together. */
+export type text = null | string | text[];
+
+/** Loose decoder for `text` */
+export const jText: Json.Loose<text> =
+ (_x: any) => Json.jUnion<null | string | text[]>(
+ Json.jNull,
+ Json.jString,
+ Json.jList(jText),
+ )(_x);
+
+/** Safe decoder for `text` */
+export const jTextSafe: Json.Safe<text> =
+ (_x: any) => Json.jFail(jText,'Text expected')(_x);
+
+/** Natural order for `text` */
+export const byText: Compare.Order<text> =
+ (_x: any, _y: any) => Compare.structural(_x,_y);
+
+/** Enum Tag Description */
+export type tag = { name: string, label: markdown, descr: markdown };
+
+/** Loose decoder for `tag` */
+export const jTag: Json.Loose<tag> =
+ Json.jObject({
+ name: Json.jFail(Json.jString,'String expected'),
+ label: jMarkdownSafe,
+ descr: jMarkdownSafe,
+ });
+
+/** Safe decoder for `tag` */
+export const jTagSafe: Json.Safe<tag> = Json.jFail(jTag,'Tag expected');
+
+/** Natural order for `tag` */
+export const byTag: Compare.Order<tag> =
+ Compare.byFields
+ <{ name: string, label: markdown, descr: markdown }>({
+ name: Compare.alpha,
+ label: byMarkdown,
+ descr: byMarkdown,
+ });
+
+/* ------------------------------------- */
diff --git a/ivette/api/kernel/project/index.ts b/ivette/api/kernel/project/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..6674b144671357e35b45ac7648ca0b0798841b7d
--- /dev/null
+++ b/ivette/api/kernel/project/index.ts
@@ -0,0 +1,133 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Project Management
+ @packageDocumentation
+ @module api/kernel/project
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+
+/** Project informations */
+export type projectInfo =
+ { id: Json.key<'#project'>, name: string, current: boolean };
+
+/** Loose decoder for `projectInfo` */
+export const jProjectInfo: Json.Loose<projectInfo> =
+ Json.jObject({
+ id: Json.jFail(Json.jKey<'#project'>('#project'),'#project expected'),
+ name: Json.jFail(Json.jString,'String expected'),
+ current: Json.jFail(Json.jBoolean,'Boolean expected'),
+ });
+
+/** Safe decoder for `projectInfo` */
+export const jProjectInfoSafe: Json.Safe<projectInfo> =
+ Json.jFail(jProjectInfo,'ProjectInfo expected');
+
+/** Natural order for `projectInfo` */
+export const byProjectInfo: Compare.Order<projectInfo> =
+ Compare.byFields
+ <{ id: Json.key<'#project'>, name: string, current: boolean }>({
+ id: Compare.primitive,
+ name: Compare.alpha,
+ current: Compare.primitive,
+ });
+
+/** Request to be executed on the specified project. */
+export type projectRequest =
+ { project: Json.key<'#project'>, request: string, data: Json.json };
+
+/** Loose decoder for `projectRequest` */
+export const jProjectRequest: Json.Loose<projectRequest> =
+ Json.jObject({
+ project: Json.jFail(Json.jKey<'#project'>('#project'),
+ '#project expected'),
+ request: Json.jFail(Json.jString,'String expected'),
+ data: Json.jAny,
+ });
+
+/** Safe decoder for `projectRequest` */
+export const jProjectRequestSafe: Json.Safe<projectRequest> =
+ Json.jFail(jProjectRequest,'ProjectRequest expected');
+
+/** Natural order for `projectRequest` */
+export const byProjectRequest: Compare.Order<projectRequest> =
+ Compare.byFields
+ <{ project: Json.key<'#project'>, request: string, data: Json.json }>({
+ project: Compare.primitive,
+ request: Compare.primitive,
+ data: Compare.structural,
+ });
+
+const getCurrent_internal: Server.GetRequest<null,projectInfo> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.project.getCurrent',
+ input: Json.jNull,
+ output: jProjectInfo,
+};
+/** Returns the current project */
+export const getCurrent: Server.GetRequest<null,projectInfo>= getCurrent_internal;
+
+const setCurrent_internal: Server.SetRequest<Json.key<'#project'>,null> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.project.setCurrent',
+ input: Json.jKey<'#project'>('#project'),
+ output: Json.jNull,
+};
+/** Switches the current project */
+export const setCurrent: Server.SetRequest<Json.key<'#project'>,null>= setCurrent_internal;
+
+const getList_internal: Server.GetRequest<null,projectInfo[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.project.getList',
+ input: Json.jNull,
+ output: Json.jList(jProjectInfo),
+};
+/** Returns the list of all projects */
+export const getList: Server.GetRequest<null,projectInfo[]>= getList_internal;
+
+const getOn_internal: Server.GetRequest<projectRequest,Json.json> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.project.getOn',
+ input: jProjectRequest,
+ output: Json.jAny,
+};
+/** Execute a GET request within the given project */
+export const getOn: Server.GetRequest<projectRequest,Json.json>= getOn_internal;
+
+const setOn_internal: Server.SetRequest<projectRequest,Json.json> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.project.setOn',
+ input: jProjectRequest,
+ output: Json.jAny,
+};
+/** Execute a SET request within the given project */
+export const setOn: Server.SetRequest<projectRequest,Json.json>= setOn_internal;
+
+const execOn_internal: Server.ExecRequest<projectRequest,Json.json> = {
+ kind: Server.RqKind.EXEC,
+ name: 'kernel.project.execOn',
+ input: jProjectRequest,
+ output: Json.jAny,
+};
+/** Execute an EXEC request within the given project */
+export const execOn: Server.ExecRequest<projectRequest,Json.json>= execOn_internal;
+
+const create_internal: Server.SetRequest<string,projectInfo> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.project.create',
+ input: Json.jString,
+ output: jProjectInfo,
+};
+/** Create a new project */
+export const create: Server.SetRequest<string,projectInfo>= create_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/kernel/properties/index.ts b/ivette/api/kernel/properties/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..92d7cc4a130b483eb06e5e3267031478de08dfce
--- /dev/null
+++ b/ivette/api/kernel/properties/index.ts
@@ -0,0 +1,338 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Property Services
+ @packageDocumentation
+ @module api/kernel/properties
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+//@ts-ignore
+import { byTag } from 'api/kernel/data';
+//@ts-ignore
+import { jTag } from 'api/kernel/data';
+//@ts-ignore
+import { jTagSafe } from 'api/kernel/data';
+//@ts-ignore
+import { tag } from 'api/kernel/data';
+//@ts-ignore
+import { bySource } from 'api/kernel/services';
+//@ts-ignore
+import { jSource } from 'api/kernel/services';
+//@ts-ignore
+import { jSourceSafe } from 'api/kernel/services';
+//@ts-ignore
+import { source } from 'api/kernel/services';
+
+/** Property Kinds */
+export enum propKind {
+ /** Contract behavior */
+ behavior = 'behavior',
+ /** Complete behaviors clause */
+ complete = 'complete',
+ /** Disjoint behaviors clause */
+ disjoint = 'disjoint',
+ /** Clause `@assumes` */
+ assumes = 'assumes',
+ /** Function precondition */
+ requires = 'requires',
+ /** Instance of a precondition at a call site */
+ instance = 'instance',
+ /** Clause `@breaks` */
+ breaks = 'breaks',
+ /** Clause `@continues` */
+ continues = 'continues',
+ /** Clause `@returns` */
+ returns = 'returns',
+ /** Clause `@exits` */
+ exits = 'exits',
+ /** Function postcondition */
+ ensures = 'ensures',
+ /** Function termination clause */
+ terminates = 'terminates',
+ /** Function allocation */
+ allocates = 'allocates',
+ /** Clause `@decreases` */
+ decreases = 'decreases',
+ /** Function assigns */
+ assigns = 'assigns',
+ /** Functional dependencies in function assigns */
+ froms = 'froms',
+ /** Assertion */
+ assert = 'assert',
+ /** Check */
+ check = 'check',
+ /** Clause `@loop invariant` */
+ loop_invariant = 'loop_invariant',
+ /** Clause `@loop assigns` */
+ loop_assigns = 'loop_assigns',
+ /** Clause `@loop variant` */
+ loop_variant = 'loop_variant',
+ /** Clause `@loop allocates` */
+ loop_allocates = 'loop_allocates',
+ /** Clause `@loop pragma` */
+ loop_pragma = 'loop_pragma',
+ /** Reachable statement */
+ reachable = 'reachable',
+ /** Statement contract */
+ code_contract = 'code_contract',
+ /** Generalized loop invariant */
+ code_invariant = 'code_invariant',
+ /** Type invariant */
+ type_invariant = 'type_invariant',
+ /** Global invariant */
+ global_invariant = 'global_invariant',
+ /** Axiomatic definitions */
+ axiomatic = 'axiomatic',
+ /** Logical axiom */
+ axiom = 'axiom',
+ /** Logical lemma */
+ lemma = 'lemma',
+}
+
+/** Loose decoder for `propKind` */
+export const jPropKind: Json.Loose<propKind> = Json.jEnum(propKind);
+
+/** Safe decoder for `propKind` */
+export const jPropKindSafe: Json.Safe<propKind> =
+ Json.jFail(Json.jEnum(propKind),'kernel.properties.propKind expected');
+
+/** Natural order for `propKind` */
+export const byPropKind: Compare.Order<propKind> = Compare.byEnum(propKind);
+
+const propKindTags_internal: Server.GetRequest<null,tag[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.properties.propKindTags',
+ input: Json.jNull,
+ output: Json.jList(jTag),
+};
+/** Registered tags for the above type. */
+export const propKindTags: Server.GetRequest<null,tag[]>= propKindTags_internal;
+
+/** Property Status (consolidated) */
+export enum propStatus {
+ /** Unknown status */
+ unknown = 'unknown',
+ /** Unknown status (never tried) */
+ never_tried = 'never_tried',
+ /** Inconsistent status */
+ inconsistent = 'inconsistent',
+ /** Valid property */
+ valid = 'valid',
+ /** Valid (under hypotheses) */
+ valid_under_hyp = 'valid_under_hyp',
+ /** Valid (external assumption) */
+ considered_valid = 'considered_valid',
+ /** Invalid property (counter example found) */
+ invalid = 'invalid',
+ /** Invalid property (under hypotheses) */
+ invalid_under_hyp = 'invalid_under_hyp',
+ /** Dead property (but invalid) */
+ invalid_but_dead = 'invalid_but_dead',
+ /** Dead property (but valid) */
+ valid_but_dead = 'valid_but_dead',
+ /** Dead property (but unknown) */
+ unknown_but_dead = 'unknown_but_dead',
+}
+
+/** Loose decoder for `propStatus` */
+export const jPropStatus: Json.Loose<propStatus> = Json.jEnum(propStatus);
+
+/** Safe decoder for `propStatus` */
+export const jPropStatusSafe: Json.Safe<propStatus> =
+ Json.jFail(Json.jEnum(propStatus),'kernel.properties.propStatus expected');
+
+/** Natural order for `propStatus` */
+export const byPropStatus: Compare.Order<propStatus> =
+ Compare.byEnum(propStatus);
+
+const propStatusTags_internal: Server.GetRequest<null,tag[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.properties.propStatusTags',
+ input: Json.jNull,
+ output: Json.jList(jTag),
+};
+/** Registered tags for the above type. */
+export const propStatusTags: Server.GetRequest<null,tag[]>= propStatusTags_internal;
+
+/** Alarm Kinds */
+export enum alarms {
+ /** Integer division by zero */
+ division_by_zero = 'division_by_zero',
+ /** Invalid pointer dereferencing */
+ mem_access = 'mem_access',
+ /** Array access out of bounds */
+ index_bound = 'index_bound',
+ /** Invalid pointer computation */
+ pointer_value = 'pointer_value',
+ /** Invalid shift */
+ shift = 'shift',
+ /** Invalid pointer comparison */
+ ptr_comparison = 'ptr_comparison',
+ /** Operation on pointers within different blocks */
+ differing_blocks = 'differing_blocks',
+ /** Integer overflow or downcast */
+ overflow = 'overflow',
+ /** Overflow in float to int conversion */
+ float_to_int = 'float_to_int',
+ /** Unsequenced side-effects on non-separated memory */
+ separation = 'separation',
+ /** Overlap between left- and right-hand-side in assignment */
+ overlap = 'overlap',
+ /** Uninitialized memory read */
+ initialization = 'initialization',
+ /** Read of a dangling pointer */
+ dangling_pointer = 'dangling_pointer',
+ /** Non-finite (nan or infinite) floating-point value */
+ is_nan_or_infinite = 'is_nan_or_infinite',
+ /** NaN floating-point value */
+ is_nan = 'is_nan',
+ /** Pointer to a function with non-compatible type */
+ function_pointer = 'function_pointer',
+ /** Uninitialized memory read of union */
+ initialization_of_union = 'initialization_of_union',
+ /** Trap representation of a _Bool lvalue */
+ bool_value = 'bool_value',
+}
+
+/** Loose decoder for `alarms` */
+export const jAlarms: Json.Loose<alarms> = Json.jEnum(alarms);
+
+/** Safe decoder for `alarms` */
+export const jAlarmsSafe: Json.Safe<alarms> =
+ Json.jFail(Json.jEnum(alarms),'kernel.properties.alarms expected');
+
+/** Natural order for `alarms` */
+export const byAlarms: Compare.Order<alarms> = Compare.byEnum(alarms);
+
+const alarmsTags_internal: Server.GetRequest<null,tag[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.properties.alarmsTags',
+ input: Json.jNull,
+ output: Json.jList(jTag),
+};
+/** Registered tags for the above type. */
+export const alarmsTags: Server.GetRequest<null,tag[]>= alarmsTags_internal;
+
+/** Data for array rows [`status`](#status) */
+export interface statusData {
+ /** Entry identifier. */
+ key: Json.key<'#status'>;
+ /** Full description */
+ descr: string;
+ /** Kind */
+ kind: propKind;
+ /** Names */
+ names: string[];
+ /** Status */
+ status: propStatus;
+ /** Function */
+ function?: Json.key<'#fct'>;
+ /** Instruction */
+ kinstr?: Json.key<'#stmt'>;
+ /** Position */
+ source: source;
+ /** Alarm name (if the property is an alarm) */
+ alarm?: string;
+ /** Alarm description (if the property is an alarm) */
+ alarm_descr?: string;
+ /** Predicate */
+ predicate?: string;
+}
+
+/** Loose decoder for `statusData` */
+export const jStatusData: Json.Loose<statusData> =
+ Json.jObject({
+ key: Json.jFail(Json.jKey<'#status'>('#status'),'#status expected'),
+ descr: Json.jFail(Json.jString,'String expected'),
+ kind: jPropKindSafe,
+ names: Json.jList(Json.jString),
+ status: jPropStatusSafe,
+ function: Json.jKey<'#fct'>('#fct'),
+ kinstr: Json.jKey<'#stmt'>('#stmt'),
+ source: jSourceSafe,
+ alarm: Json.jString,
+ alarm_descr: Json.jString,
+ predicate: Json.jString,
+ });
+
+/** Safe decoder for `statusData` */
+export const jStatusDataSafe: Json.Safe<statusData> =
+ Json.jFail(jStatusData,'StatusData expected');
+
+/** Natural order for `statusData` */
+export const byStatusData: Compare.Order<statusData> =
+ Compare.byFields
+ <{ key: Json.key<'#status'>, descr: string, kind: propKind,
+ names: string[], status: propStatus, function?: Json.key<'#fct'>,
+ kinstr?: Json.key<'#stmt'>, source: source, alarm?: string,
+ alarm_descr?: string, predicate?: string }>({
+ key: Compare.primitive,
+ descr: Compare.primitive,
+ kind: byPropKind,
+ names: Compare.array(Compare.primitive),
+ status: byPropStatus,
+ function: Compare.defined(Compare.primitive),
+ kinstr: Compare.defined(Compare.primitive),
+ source: bySource,
+ alarm: Compare.defined(Compare.primitive),
+ alarm_descr: Compare.defined(Compare.primitive),
+ predicate: Compare.defined(Compare.primitive),
+ });
+
+/** Signal for array [`status`](#status) */
+export const signalStatus: Server.Signal = {
+ name: 'kernel.properties.signalStatus',
+};
+
+const reloadStatus_internal: Server.GetRequest<null,null> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.properties.reloadStatus',
+ input: Json.jNull,
+ output: Json.jNull,
+};
+/** Force full reload for array [`status`](#status) */
+export const reloadStatus: Server.GetRequest<null,null>= reloadStatus_internal;
+
+const fetchStatus_internal: Server.GetRequest<
+ number,
+ { pending: number, updated: statusData[], removed: Json.key<'#status'>[],
+ reload: boolean }
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.properties.fetchStatus',
+ input: Json.jNumber,
+ output: Json.jObject({
+ pending: Json.jFail(Json.jNumber,'Number expected'),
+ updated: Json.jList(jStatusData),
+ removed: Json.jList(Json.jKey<'#status'>('#status')),
+ reload: Json.jFail(Json.jBoolean,'Boolean expected'),
+ }),
+};
+/** Data fetcher for array [`status`](#status) */
+export const fetchStatus: Server.GetRequest<
+ number,
+ { pending: number, updated: statusData[], removed: Json.key<'#status'>[],
+ reload: boolean }
+ >= fetchStatus_internal;
+
+const status_internal: State.Array<Json.key<'#status'>,statusData> = {
+ name: 'kernel.properties.status',
+ getkey: ((d:statusData) => d.key),
+ signal: signalStatus,
+ fetch: fetchStatus,
+ reload: reloadStatus,
+ order: byStatusData,
+};
+/** Status of Registered Properties */
+export const status: State.Array<Json.key<'#status'>,statusData> = status_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/kernel/services/index.ts b/ivette/api/kernel/services/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..cdc371d34b5398ba484204c25ad4712e3899d378
--- /dev/null
+++ b/ivette/api/kernel/services/index.ts
@@ -0,0 +1,175 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Kernel Services
+ @packageDocumentation
+ @module api/kernel/services
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+//@ts-ignore
+import { byTag } from 'api/kernel/data';
+//@ts-ignore
+import { jTag } from 'api/kernel/data';
+//@ts-ignore
+import { jTagSafe } from 'api/kernel/data';
+//@ts-ignore
+import { tag } from 'api/kernel/data';
+
+const getConfig_internal: Server.GetRequest<
+ null,
+ { pluginpath: string[], libdir: string, datadir: string, version: string }
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.services.getConfig',
+ input: Json.jNull,
+ output: Json.jObject({
+ pluginpath: Json.jList(Json.jString),
+ libdir: Json.jFail(Json.jString,'String expected'),
+ datadir: Json.jFail(Json.jString,'String expected'),
+ version: Json.jFail(Json.jString,'String expected'),
+ }),
+};
+/** Frama-C Kernel configuration */
+export const getConfig: Server.GetRequest<
+ null,
+ { pluginpath: string[], libdir: string, datadir: string, version: string }
+ >= getConfig_internal;
+
+const load_internal: Server.SetRequest<string,string | undefined> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.services.load',
+ input: Json.jString,
+ output: Json.jString,
+};
+/** Load a save file. Returns an error, if not successfull. */
+export const load: Server.SetRequest<string,string | undefined>= load_internal;
+
+/** Source file positions. */
+export type source =
+ { dir: string, base: string, file: string, line: number };
+
+/** Loose decoder for `source` */
+export const jSource: Json.Loose<source> =
+ Json.jObject({
+ dir: Json.jFail(Json.jString,'String expected'),
+ base: Json.jFail(Json.jString,'String expected'),
+ file: Json.jFail(Json.jString,'String expected'),
+ line: Json.jFail(Json.jNumber,'Number expected'),
+ });
+
+/** Safe decoder for `source` */
+export const jSourceSafe: Json.Safe<source> =
+ Json.jFail(jSource,'Source expected');
+
+/** Natural order for `source` */
+export const bySource: Compare.Order<source> =
+ Compare.byFields
+ <{ dir: string, base: string, file: string, line: number }>({
+ dir: Compare.primitive,
+ base: Compare.primitive,
+ file: Compare.primitive,
+ line: Compare.primitive,
+ });
+
+/** Log messages categories. */
+export enum logkind {
+ /** User Error */
+ ERROR = 'ERROR',
+ /** User Warning */
+ WARNING = 'WARNING',
+ /** Plugin Feedback */
+ FEEDBACK = 'FEEDBACK',
+ /** Plugin Result */
+ RESULT = 'RESULT',
+ /** Plugin Failure */
+ FAILURE = 'FAILURE',
+ /** Analyser Debug */
+ DEBUG = 'DEBUG',
+}
+
+/** Loose decoder for `logkind` */
+export const jLogkind: Json.Loose<logkind> = Json.jEnum(logkind);
+
+/** Safe decoder for `logkind` */
+export const jLogkindSafe: Json.Safe<logkind> =
+ Json.jFail(Json.jEnum(logkind),'kernel.services.logkind expected');
+
+/** Natural order for `logkind` */
+export const byLogkind: Compare.Order<logkind> = Compare.byEnum(logkind);
+
+const logkindTags_internal: Server.GetRequest<null,tag[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.services.logkindTags',
+ input: Json.jNull,
+ output: Json.jList(jTag),
+};
+/** Registered tags for the above type. */
+export const logkindTags: Server.GetRequest<null,tag[]>= logkindTags_internal;
+
+/** Message event record. */
+export interface log {
+ /** Message kind */
+ kind: logkind;
+ /** Emitter plugin */
+ plugin: string;
+ /** Message text */
+ message: string;
+ /** Message category (DEBUG or WARNING) */
+ category?: string;
+ /** Source file position */
+ source?: source;
+}
+
+/** Loose decoder for `log` */
+export const jLog: Json.Loose<log> =
+ Json.jObject({
+ kind: jLogkindSafe,
+ plugin: Json.jFail(Json.jString,'String expected'),
+ message: Json.jFail(Json.jString,'String expected'),
+ category: Json.jString,
+ source: jSource,
+ });
+
+/** Safe decoder for `log` */
+export const jLogSafe: Json.Safe<log> = Json.jFail(jLog,'Log expected');
+
+/** Natural order for `log` */
+export const byLog: Compare.Order<log> =
+ Compare.byFields
+ <{ kind: logkind, plugin: string, message: string, category?: string,
+ source?: source }>({
+ kind: byLogkind,
+ plugin: Compare.alpha,
+ message: Compare.primitive,
+ category: Compare.defined(Compare.primitive),
+ source: Compare.defined(bySource),
+ });
+
+const setLogs_internal: Server.SetRequest<boolean,null> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.services.setLogs',
+ input: Json.jBoolean,
+ output: Json.jNull,
+};
+/** Turn logs monitoring on/off */
+export const setLogs: Server.SetRequest<boolean,null>= setLogs_internal;
+
+const getLogs_internal: Server.GetRequest<null,log[]> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.services.getLogs',
+ input: Json.jNull,
+ output: Json.jList(jLog),
+};
+/** Flush the last emitted logs since last call (max 100) */
+export const getLogs: Server.GetRequest<null,log[]>= getLogs_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/plugins/dive/index.ts b/ivette/api/plugins/dive/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..e1bc260040c20ab9541d1464d712df6ce5af8c94
--- /dev/null
+++ b/ivette/api/plugins/dive/index.ts
@@ -0,0 +1,118 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Dive Services
+ @packageDocumentation
+ @module api/plugins/dive
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+
+/** The name of variable of the program */
+export interface variableName {
+ /** owner function for a local variable */
+ funName?: string;
+ /** variable name */
+ varName: string;
+}
+
+/** Loose decoder for `variableName` */
+export const jVariableName: Json.Loose<variableName> =
+ Json.jObject({
+ funName: Json.jString,
+ varName: Json.jFail(Json.jString,'String expected'),
+ });
+
+/** Safe decoder for `variableName` */
+export const jVariableNameSafe: Json.Safe<variableName> =
+ Json.jFail(jVariableName,'VariableName expected');
+
+/** Natural order for `variableName` */
+export const byVariableName: Compare.Order<variableName> =
+ Compare.byFields
+ <{ funName?: string, varName: string }>({
+ funName: Compare.defined(Compare.alpha),
+ varName: Compare.alpha,
+ });
+
+const graph_internal: Server.GetRequest<null,Json.json> = {
+ kind: Server.RqKind.GET,
+ name: 'plugins.dive.graph',
+ input: Json.jNull,
+ output: Json.jAny,
+};
+/** Retrieve the whole graph */
+export const graph: Server.GetRequest<null,Json.json>= graph_internal;
+
+const clear_internal: Server.ExecRequest<null,null> = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.clear',
+ input: Json.jNull,
+ output: Json.jNull,
+};
+/** Erase the graph and start over with an empty one */
+export const clear: Server.ExecRequest<null,null>= clear_internal;
+
+const addVar_internal: Server.ExecRequest<variableName,Json.json> = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.addVar',
+ input: jVariableName,
+ output: Json.jAny,
+};
+/** Add a variable to the graph */
+export const addVar: Server.ExecRequest<variableName,Json.json>= addVar_internal;
+
+const addFunctionAlarms_internal: Server.ExecRequest<
+ Json.key<'#fct'>,
+ Json.json
+ > = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.addFunctionAlarms',
+ input: Json.jKey<'#fct'>('#fct'),
+ output: Json.jAny,
+};
+/** Add all alarms of the given function */
+export const addFunctionAlarms: Server.ExecRequest<
+ Json.key<'#fct'>,
+ Json.json
+ >= addFunctionAlarms_internal;
+
+const explore_internal: Server.ExecRequest<
+ Json.index<'#dive-node'>,
+ Json.json
+ > = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.explore',
+ input: Json.jIndex<'#dive-node'>('#dive-node'),
+ output: Json.jAny,
+};
+/** Explore the graph starting from an existing vertex */
+export const explore: Server.ExecRequest<Json.index<'#dive-node'>,Json.json>= explore_internal;
+
+const show_internal: Server.ExecRequest<Json.index<'#dive-node'>,Json.json> = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.show',
+ input: Json.jIndex<'#dive-node'>('#dive-node'),
+ output: Json.jAny,
+};
+/** Show the dependencies of an existing vertex */
+export const show: Server.ExecRequest<Json.index<'#dive-node'>,Json.json>= show_internal;
+
+const hide_internal: Server.ExecRequest<Json.index<'#dive-node'>,Json.json> = {
+ kind: Server.RqKind.EXEC,
+ name: 'plugins.dive.hide',
+ input: Json.jIndex<'#dive-node'>('#dive-node'),
+ output: Json.jAny,
+};
+/** Hide the dependencies of an existing vertex */
+export const hide: Server.ExecRequest<Json.index<'#dive-node'>,Json.json>= hide_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/plugins/eva/index.ts b/ivette/api/plugins/eva/index.ts
new file mode 100644
index 0000000000000000000000000000000000000000..4b46b34354923641cd17852220a4a7ff037b790f
--- /dev/null
+++ b/ivette/api/plugins/eva/index.ts
@@ -0,0 +1,40 @@
+/* --- Generated Frama-C Server API --- */
+
+/**
+ Eva General Services
+ @packageDocumentation
+ @module api/plugins/eva
+*/
+
+//@ts-ignore
+import * as Json from 'dome/data/json';
+//@ts-ignore
+import * as Compare from 'dome/data/compare';
+//@ts-ignore
+import * as Server from 'frama-c/server';
+//@ts-ignore
+import * as State from 'frama-c/states';
+
+
+const getCallers_internal: Server.GetRequest<
+ Json.key<'#fct'>,
+ [ Json.key<'#fct'>, Json.key<'#stmt'> ][]
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'plugins.eva.getCallers',
+ input: Json.jKey<'#fct'>('#fct'),
+ output: Json.jList(Json.jTry(
+ Json.jPair(
+ Json.jFail(Json.jKey<'#fct'>('#fct'),
+ '#fct expected'),
+ Json.jFail(Json.jKey<'#stmt'>('#stmt'),
+ '#stmt expected'),
+ ))),
+};
+/** Get the list of call site of a function */
+export const getCallers: Server.GetRequest<
+ Json.key<'#fct'>,
+ [ Json.key<'#fct'>, Json.key<'#stmt'> ][]
+ >= getCallers_internal;
+
+/* ------------------------------------- */
diff --git a/ivette/api/server_tsc.ml b/ivette/api/server_tsc.ml
new file mode 100644
index 0000000000000000000000000000000000000000..8f5eb6e829b7992c706487f59d1b23b226f80421
--- /dev/null
+++ b/ivette/api/server_tsc.ml
@@ -0,0 +1,515 @@
+(* -------------------------------------------------------------------------- *)
+(* --- Frama-C TypeScript API Generator --- *)
+(* -------------------------------------------------------------------------- *)
+
+module Self = Plugin.Register
+ (struct
+ let name = "Server TypeScript API"
+ let shortname = "server-tsc"
+ let help = "Generate TypeScript API for Server"
+ end)
+
+module TSC = Self.Action
+ (struct
+ let option_name = "-server-tsc"
+ let help = "Generate TypeScript API"
+ end)
+
+module OUT = Self.String
+ (struct
+ let option_name = "-server-tsc-out"
+ let arg_name = "dir"
+ let default = "api"
+ let help = "Output directory (default is './api')"
+ end)
+
+module Md = Markdown
+module Pkg = Server.Package
+
+(* -------------------------------------------------------------------------- *)
+(* --- TS Utils --- *)
+(* -------------------------------------------------------------------------- *)
+
+let keywords = [
+ "break"; "case"; "catch"; "class"; "const"; "continue"; "debugger";
+ "default"; "delete"; "do"; "else"; "enum"; "export"; "extends"; "false";
+ "finally"; "for"; "function"; "if"; "import"; "in"; "instanceof"; "new";
+ "null"; "return"; "super"; "switch"; "this"; "throw"; "true"; "try";
+ "typeof"; "var"; "void"; "while"; "with"; "as"; "implements"; "interface";
+ "let"; "package"; "private"; "protected"; "public"; "static"; "yield"; "any";
+ "boolean"; "constructor"; "declare"; "get"; "module"; "require"; "number";
+ "set"; "string"; "symbol"; "type"; "from"; "of";
+ "Json"; "Compare"; "Server"; "State";
+]
+
+let pp_descr = Md.pp_text ?page:None
+
+let name_of_kind = function
+ | `GET -> "GET"
+ | `SET -> "SET"
+ | `EXEC -> "EXEC"
+
+let makeDescr ?(indent="") fmt descr =
+ if descr <> [] then
+ Format.fprintf fmt "%s/** @[<hov 0>%a@] */@." indent pp_descr descr
+
+let getSelf = function
+ | None -> Self.fatal "Unexpected recursive type"
+ | Some id -> id
+
+(* -------------------------------------------------------------------------- *)
+(* --- Jtype Generator --- *)
+(* -------------------------------------------------------------------------- *)
+
+let makeJtype ?self ~names =
+ let open Pkg in
+ let pp_ident fmt id =
+ match IdMap.find id names with
+ | name -> Format.pp_print_string fmt name
+ | exception Not_found -> Self.abort "Undefined '%a'" pp_ident id in
+ let rec pp fmt = function
+ | Jany -> Format.pp_print_string fmt "Json.json"
+ | Jself -> Format.pp_print_string fmt (getSelf self).name
+ | Jnull -> Format.pp_print_string fmt "null"
+ | Jnumber -> Format.pp_print_string fmt "number"
+ | Jboolean -> Format.pp_print_string fmt "boolean"
+ | Jstring | Jalpha -> Format.pp_print_string fmt "string"
+ | Jkey kd -> Format.fprintf fmt "Json.key<'#%s'>" kd
+ | Jindex kd -> Format.fprintf fmt "Json.index<'#%s'>" kd
+ | Jdict(kd,js) -> Format.fprintf fmt "Json.Dict<'#%s',%a>" kd pp js
+ | Jdata id | Jenum id -> pp_ident fmt id
+ | Joption js -> Format.fprintf fmt "%a |@ undefined" pp js
+ | Jtuple js ->
+ Pretty_utils.pp_list ~pre:"@[<hov 2>[ " ~sep:",@ " ~suf:"@ ]@]" pp fmt js
+ | Junion js ->
+ Pretty_utils.pp_list ~pre:"@[<hov 0>" ~sep:" |@ " ~suf:"@]" protect fmt js
+ | Jrecord fjs ->
+ Pretty_utils.pp_list ~pre:"@[<hov 2>{ " ~sep:",@ " ~suf:"@ }@]" field fmt fjs
+ | Jarray js | Jlist js -> Format.fprintf fmt "%a[]" protect js
+ and protect fmt js = match js with
+ | Junion _ | Joption _ -> Format.fprintf fmt "@[<hov 2>(%a)@]" pp js
+ | _ -> pp fmt js
+ and field fmt (fd,js) =
+ match js with
+ | Joption js ->
+ Format.fprintf fmt "@[<hov 4>%s?:@ %a@]" fd pp js
+ | _ ->
+ Format.fprintf fmt "@[<hov 4>%s:@ %a@]" fd pp js
+ in pp
+
+(* -------------------------------------------------------------------------- *)
+(* --- Jtype Decoder --- *)
+(* -------------------------------------------------------------------------- *)
+
+let jprim fmt name = Format.fprintf fmt "Json.%s" name
+let jkey fmt kd = Format.fprintf fmt "Json.jKey<'#%s'>('#%s')" kd kd
+let jindex fmt kd = Format.fprintf fmt "Json.jIndex<'#%s'>('#%s')" kd kd
+
+let jcall names fmt id =
+ try Format.pp_print_string fmt (Pkg.IdMap.find id names)
+ with Not_found -> Self.abort "Undefined identifier '%a'" Pkg.pp_ident id
+
+let jsafe ~safe msg pp fmt d =
+ if safe then
+ Format.fprintf fmt "@[<hov 2>Json.jFail(@,%a,@,'%s expected')@]" pp d msg
+ else
+ pp fmt d
+
+let jtry ~safe pp fmt d =
+ if safe then
+ pp fmt d
+ else
+ Format.fprintf fmt "@[<hov 2>Json.jTry(@,%a)@]" pp d
+
+let jenum names fmt id = Format.fprintf fmt "Json.jEnum(%a)" (jcall names) id
+
+let junion ~jtype ~makeLoose fmt jts =
+ begin
+ Format.fprintf fmt "@[<hv 0>@[<hv 2>Json.jUnion<%a>("
+ jtype (Pkg.Junion jts) ;
+ List.iter
+ (fun js -> Format.fprintf fmt "@ @[<hov 2>%a@]," makeLoose js) jts ;
+ Format.fprintf fmt "@]@,)@]" ;
+ end
+
+let jrecord ~makeSafe fmt jts =
+ begin
+ Format.fprintf fmt "@[<hv 0>@[<hv 2>Json.jObject({" ;
+ List.iter
+ (fun (fd,js) ->
+ Format.fprintf fmt "@ @[<hov 2>%s: %a@]," fd makeSafe js) jts ;
+ Format.fprintf fmt "@]@,})@]" ;
+ end
+
+let jtuple ~makeSafe fmt jts =
+ begin
+ let name = match List.length jts with
+ | 2 -> "jPair"
+ | 3 -> "jTriple"
+ | 4 -> "jTuple4"
+ | 5 -> "jTuple5"
+ | n -> Self.fatal "No jTuple%d defined" n
+ in
+ Format.fprintf fmt "@[<hv 0>@[<hv 2>Json.%s(" name ;
+ List.iter
+ (fun js -> Format.fprintf fmt "@ @[<hov 2>%a@]," makeSafe js) jts ;
+ Format.fprintf fmt "@]@,)@]" ;
+ end
+
+let rec makeDecoder ~safe ?self ~names fmt js =
+ let open Pkg in
+ let makeSafe = makeDecoder ?self ~names ~safe:true in
+ let makeLoose = makeDecoder ?self ~names ~safe:false in
+ match js with
+ | Jany -> jprim fmt "jAny"
+ | Jnull -> jprim fmt "jNull"
+ | Jboolean -> jsafe ~safe "Boolean" jprim fmt "jBoolean"
+ | Jnumber -> jsafe ~safe "Number" jprim fmt "jNumber"
+ | Jstring | Jalpha -> jsafe ~safe "String" jprim fmt "jString"
+ | Jkey kd -> jsafe ~safe ("#" ^ kd) jkey fmt kd
+ | Jindex kd -> jsafe ~safe ("#" ^ kd) jindex fmt kd
+ | Jdata id -> jcall names fmt (Pkg.Derived.decode ~safe id)
+ | Jenum id -> jsafe ~safe (Pkg.name_of_ident id) (jenum names) fmt id
+ | Jself -> jcall names fmt (Pkg.Derived.decode ~safe (getSelf self))
+ | Joption js -> makeLoose fmt js
+ | Jdict(kd,js) ->
+ Format.fprintf fmt "@[<hov 2>Json.jDictionary('#%s',@,%a)@]" kd makeLoose js
+ | Jlist js ->
+ Format.fprintf fmt "@[<hov 2>Json.jList(%a)@]" makeLoose js
+ | Jarray js ->
+ if safe
+ then Format.fprintf fmt "@[<hov 2>Json.jArray(%a)@]" makeSafe js
+ else Format.fprintf fmt "@[<hov 2>Json.jTry(jArray(%a))@]" makeSafe js
+ | Junion jts ->
+ let jtype = makeJtype ?self ~names in
+ jsafe ~safe "Union" (junion ~jtype ~makeLoose) fmt jts
+ | Jrecord jfs -> jsafe ~safe "Record" (jrecord ~makeSafe) fmt jfs
+ | Jtuple jts -> jtry ~safe (jtuple ~makeSafe) fmt jts
+
+let makeRootDecoder ~safe ~self ~names fmt js =
+ let open Pkg in
+ match js with
+ | Joption _ | Jdict _ | Jlist _ when safe ->
+ jcall names fmt (Pkg.Derived.loose self)
+ | Jtuple _ | Jarray _ when not safe ->
+ Format.fprintf fmt "Json.jTry(%a)"
+ (jcall names) (Pkg.Derived.safe self)
+ | Junion _ | Jrecord _ when safe ->
+ Format.fprintf fmt "Json.jFail(%a,'%s expected')"
+ (jcall names) (Pkg.Derived.loose self)
+ (String.capitalize_ascii self.name)
+ | _ -> makeDecoder ~safe ~self ~names fmt js
+
+(* -------------------------------------------------------------------------- *)
+(* --- Parameter Decoder --- *)
+(* -------------------------------------------------------------------------- *)
+
+let typeOfParam = function
+ | Pkg.P_value js -> js
+ | Pkg.P_named fjs -> Jrecord (List.map Pkg.field fjs)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Jtype Order --- *)
+(* -------------------------------------------------------------------------- *)
+
+let makeOrder ~self ~names fmt js =
+ let open Pkg in
+ let rec pp fmt = function
+ | Jnull -> Format.pp_print_string fmt "Compare.equal"
+ | Jalpha -> Format.pp_print_string fmt "Compare.alpha"
+ | Jnumber | Jstring | Jboolean | Jkey _ | Jindex _
+ -> Format.pp_print_string fmt "Compare.primitive"
+ | Jself -> jcall names fmt (Pkg.Derived.order self)
+ | Jdata id -> jcall names fmt (Pkg.Derived.order id)
+ | Joption js ->
+ Format.fprintf fmt "@[<hov 2>Compare.defined(@,%a)@]" pp js
+ | Jany | Junion _ -> (* Can not find a better solution *)
+ Format.fprintf fmt "Compare.structural"
+ | Jenum id ->
+ Format.fprintf fmt "@[<hov 2>Compare.byEnum(@,%a)@]" (jcall names) id
+ | Jlist js | Jarray js ->
+ Format.fprintf fmt "@[<hov 2>Compare.array(@,%a)@]" pp js
+ | Jtuple jts ->
+ let name = match List.length jts with
+ | 2 -> "pair"
+ | 3 -> "triple"
+ | 4 -> "tuple4"
+ | 5 -> "tuple5"
+ | n -> Self.abort "No comparison for %d-tuples" n in
+ Format.fprintf fmt "@[<hv 0>@[<hv 2>Compare.%s(" name ;
+ List.iter (fun js -> Format.fprintf fmt "@,%a," pp js) jts ;
+ Format.fprintf fmt "@]@,)@]" ;
+ | Jrecord jfs ->
+ Format.fprintf fmt "@[<hv 0>@[<hv 2>Compare.byFields@,<%a>({"
+ (makeJtype ~self ~names) (Jrecord jfs) ;
+ List.iter
+ (fun (fd,js) -> Format.fprintf fmt "@ @[<hov 2>%s: %a,@]" fd pp js) jfs ;
+ Format.fprintf fmt "@]@ })@]" ;
+ | Jdict(kd,js) ->
+ let jtype fmt js = makeJtype ~names fmt js in
+ Format.fprintf fmt
+ "@[<hov 2>Compare.dictionary<@,Json.dict<'#%s'@,%a>>(@,%a)@]"
+ kd jtype js pp js
+ in pp fmt js
+
+(* -------------------------------------------------------------------------- *)
+(* --- Declaration Generator --- *)
+(* -------------------------------------------------------------------------- *)
+
+let makeRecursive fn fmt js =
+ if Pkg.isRecursive js then
+ Format.fprintf fmt "(_x: any) => %a(_x)" fn js
+ else fn fmt js
+
+let makeRecursive2 fn fmt js =
+ if Pkg.isRecursive js then
+ Format.fprintf fmt "(_x: any, _y: any) => %a(_x,_y)" fn js
+ else fn fmt js
+
+let makeDeclaration fmt names d =
+ let open Pkg in
+ Format.pp_print_newline fmt () ;
+ let self = d.d_ident in
+ let jtype = makeJtype ~self ~names in
+ match d.d_kind with
+
+ | D_type js ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt "@[<hv 2>export type %s =@ %a;@]@\n" self.name jtype js
+
+ | D_record fjs ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt "export interface %s {@\n" self.name ;
+ List.iter
+ (fun { fd_name = fd ; fd_type = js ; fd_descr = doc } ->
+ makeDescr ~indent:" " fmt doc ;
+ match js with
+ | Joption js ->
+ Format.fprintf fmt " @[<hov 2>%s?: %a;@]@\n" fd jtype js
+ | _ ->
+ Format.fprintf fmt " @[<hov 2>%s: %a;@]@\n" fd jtype js
+ ) fjs ;
+ Format.fprintf fmt "}@\n"
+
+ | D_enum tgs ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt "export enum %s {@\n" self.name ;
+ List.iter
+ (fun { tg_name = tag ; tg_descr = doc } ->
+ makeDescr ~indent:" " fmt doc ;
+ Format.fprintf fmt " %s = '%s',@\n" tag tag ;
+ ) tgs ;
+ Format.fprintf fmt "}@\n"
+
+ | D_signal ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt "export const %s: Server.Signal = {@\n" self.name ;
+ Format.fprintf fmt " name: '%s',@\n" (Pkg.name_of_ident d.d_ident) ;
+ Format.fprintf fmt "};@\n"
+
+ | D_request rq ->
+ let kind = name_of_kind rq.rq_kind in
+ let prefix = String.capitalize_ascii (String.lowercase_ascii kind) in
+ let input = typeOfParam rq.rq_input in
+ let output = typeOfParam rq.rq_output in
+ let makeParam fmt js = makeDecoder ~safe:false ~names fmt js in
+ Format.fprintf fmt
+ "@[<hv 2>const %s_internal: Server.%sRequest<@,%a,@,%a@,>@] = {@\n"
+ self.name prefix jtype input jtype output ;
+ Format.fprintf fmt " kind: Server.RqKind.%s,@\n" kind ;
+ Format.fprintf fmt " name: '%s',@\n" (Pkg.name_of_ident d.d_ident) ;
+ Format.fprintf fmt " input: %a,@\n" makeParam input ;
+ Format.fprintf fmt " output: %a,@\n" makeParam output ;
+ Format.fprintf fmt "};@\n" ;
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hv 2>export const %s: Server.%sRequest<@,%a,@,%a@,>@]\
+ = %s_internal;@\n"
+ self.name prefix jtype input jtype output self.name ;
+
+ | D_value js ->
+ Format.fprintf fmt
+ "@[<hv 2>const %s_internal: State.Value<@,%a@,>@] = {\n"
+ self.name jtype js ;
+ Format.fprintf fmt " name: '%s',@\n" (Pkg.name_of_ident self) ;
+ Format.fprintf fmt " signal: %a,@\n"
+ (jcall names) (Pkg.Derived.signal self) ;
+ Format.fprintf fmt " getter: %a,@\n"
+ (jcall names) (Pkg.Derived.getter self) ;
+ Format.fprintf fmt "};@\n" ;
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hv 2>export const %s: State.Value<@,%a@,>@] = %s_internal;\n"
+ self.name jtype js self.name ;
+
+ | D_state js ->
+ Format.fprintf fmt
+ "@[<hv 2>const %s_internal: State.State<@,%a@,>@] = {@\n"
+ self.name jtype js ;
+ Format.fprintf fmt " name: '%s',@\n" (Pkg.name_of_ident self) ;
+ Format.fprintf fmt " signal: %a,@\n"
+ (jcall names) (Pkg.Derived.signal self) ;
+ Format.fprintf fmt " getter: %a,@\n"
+ (jcall names) (Pkg.Derived.getter self) ;
+ Format.fprintf fmt " setter: %a,@\n"
+ (jcall names) (Pkg.Derived.setter self) ;
+ Format.fprintf fmt "};@\n" ;
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hv 2>export const %s: State.State<@,%a@,>@] = %s_internal;@\n"
+ self.name jtype js self.name;
+
+
+ | D_array { arr_key ; arr_kind } ->
+ let data = Pkg.Derived.data self in
+ let jkey = (Pkg.Jkey arr_kind) in
+ let jrow = (Pkg.Jdata data) in
+ Format.fprintf fmt
+ "@[<hv 2>const %s_internal: State.Array<@,%a,@,%a@,>@] = {@\n"
+ self.name jtype jkey jtype jrow ;
+ Format.fprintf fmt " name: '%s',@\n" (Pkg.name_of_ident self) ;
+ Format.fprintf fmt " getkey: ((d:%a) => d.%s),@\n" jtype jrow arr_key ;
+ Format.fprintf fmt " signal: %a,@\n"
+ (jcall names) (Pkg.Derived.signal self) ;
+ Format.fprintf fmt " fetch: %a,@\n"
+ (jcall names) (Pkg.Derived.fetch self) ;
+ Format.fprintf fmt " reload: %a,@\n"
+ (jcall names) (Pkg.Derived.reload self) ;
+ Format.fprintf fmt " order: %a,@\n"
+ (jcall names) (Pkg.Derived.order data) ;
+ Format.fprintf fmt "};@\n" ;
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hv 2>export const %s: State.Array<@,%a,@,%a@,>@] = %s_internal;@\n"
+ self.name jtype jkey jtype jrow self.name ;
+
+ | D_safe(id,js) ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hov 2>@[<hv 0>export const %s: Json.Safe<@,%a@,>@] =@ %a;@]\n"
+ self.name (jcall names) id
+ (makeRecursive (makeRootDecoder ~safe:true ~self:id ~names)) js
+
+ | D_loose(id,js) ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hov 2>@[<hv 0>export const %s: Json.Loose<@,%a@,>@] =@ %a;@]\n"
+ self.name (jcall names) id
+ (makeRecursive (makeRootDecoder ~safe:false ~self:id ~names)) js
+
+ | D_order(id,js) ->
+ makeDescr fmt d.d_descr ;
+ Format.fprintf fmt
+ "@[<hov 2>@[<hv 0>export const %s: Compare.Order<@,%a@,>@] =@ %a;@]\n"
+ self.name (jcall names) id
+ (makeRecursive2 (makeOrder ~self:id ~names)) js
+
+(* -------------------------------------------------------------------------- *)
+(* --- Declaration Ranking --- *)
+(* -------------------------------------------------------------------------- *)
+
+type ranking = {
+ mutable rank : int ;
+ mutable mark : int Pkg.IdMap.t ;
+}
+
+let depends d =
+ match d.Pkg.d_kind with
+ | D_loose(id,(Jtuple _ | Jarray _)) -> [Pkg.Derived.safe id]
+ | D_safe(id,_) -> [Pkg.Derived.loose id]
+ | D_array _ ->
+ let id = d.d_ident in
+ let data = Pkg.Derived.data id in
+ [
+ data ;
+ Pkg.Derived.loose data ;
+ Pkg.Derived.safe data ;
+ Pkg.Derived.order data ;
+ Pkg.Derived.signal id ;
+ Pkg.Derived.reload id ;
+ Pkg.Derived.fetch id ;
+ ]
+ | _ -> []
+
+let next m id =
+ let r = m.rank in
+ m.mark <- Pkg.IdMap.add id r m.mark ;
+ m.rank <- succ r
+
+let mark m d =
+ let id = d.Pkg.d_ident in
+ if not (Pkg.IdMap.mem id m.mark) then
+ ( List.iter (next m) (depends d) ; next m id )
+
+let ranking ds =
+ let m = { rank = 0 ; mark = Pkg.IdMap.empty } in
+ List.iter (mark m) ds ;
+ let rk = m.mark in
+ let getRank a = try Pkg.IdMap.find a.Pkg.d_ident rk with Not_found -> 0 in
+ List.sort (fun a b -> getRank a - getRank b) ds
+
+(* -------------------------------------------------------------------------- *)
+(* --- Package Generator --- *)
+(* -------------------------------------------------------------------------- *)
+
+let makeIgnore fmt msg =
+ Format.fprintf fmt "//@ts-ignore@\n" ;
+ Format.fprintf fmt msg
+
+let makePackage pkg name fmt =
+ begin
+ let open Pkg in
+ Format.fprintf fmt "/* --- Generated Frama-C Server API --- */@\n@\n" ;
+ Format.fprintf fmt "/**@\n %s@\n" pkg.p_title ;
+ if pkg.p_descr <> [] then
+ Format.fprintf fmt "@\n @[<hov 0>%a@]@\n@\n" pp_descr pkg.p_descr ;
+ Format.fprintf fmt " @@packageDocumentation@\n" ;
+ Format.fprintf fmt " @@module api/%s@\n" name ;
+ Format.fprintf fmt "*/@\n@." ;
+ let names = Pkg.resolve ~keywords pkg in
+ makeIgnore fmt "import * as Json from 'dome/data/json';@\n" ;
+ makeIgnore fmt "import * as Compare from 'dome/data/compare';@\n" ;
+ makeIgnore fmt "import * as Server from 'frama-c/server';@\n" ;
+ makeIgnore fmt "import * as State from 'frama-c/states';@\n" ;
+ Format.pp_print_newline fmt () ;
+ Pkg.IdMap.iter
+ (fun id name ->
+ if id.plugin <> pkg.p_plugin ||
+ id.package <> pkg.p_package
+ then
+ let pkg = Pkg.name_of_pkg ~sep:"/" id.plugin id.package in
+ if id.name = name then
+ makeIgnore fmt "import { %s } from 'api/%s';@\n"
+ name pkg
+ else
+ makeIgnore fmt "import { %s: %s } from 'api/%s';@\n"
+ id.name name pkg
+ ) names ;
+ List.iter
+ (makeDeclaration fmt names)
+ (ranking pkg.p_content) ;
+ Format.pp_print_newline fmt () ;
+ Format.fprintf fmt "/* ------------------------------------- */@." ;
+ end
+
+(* -------------------------------------------------------------------------- *)
+(* --- Main Generator --- *)
+(* -------------------------------------------------------------------------- *)
+
+let generate () =
+ begin
+ Pkg.iter
+ begin fun pkg ->
+ Self.feedback "Package %a" Pkg.pp_pkgname pkg ;
+ let name = Pkg.name_of_pkginfo ~sep:"/" pkg in
+ let file = Printf.sprintf "%s/%s/index.ts" (OUT.get ()) name in
+ let dir = Filename.dirname file in
+ if not (Sys.file_exists dir && Sys.is_directory dir) then
+ Extlib.mkdir ~parents:true dir 0o755 ;
+ Command.print_file file (makePackage pkg name) ;
+ end
+ end
+
+let () = Db.Main.extend generate
+
+(* -------------------------------------------------------------------------- *)
diff --git a/ivette/backup/sandbox/Project.js b/ivette/backup/sandbox/Project.js
deleted file mode 100644
index 37d33df468aedf4ad087430193c8e6ba1c18d445..0000000000000000000000000000000000000000
--- a/ivette/backup/sandbox/Project.js
+++ /dev/null
@@ -1,206 +0,0 @@
-import React, { useState, useEffect } from 'react';
-import { showOpenFiles } from 'dome/dialogs';
-import { Button } from 'dome/controls/buttons';
-import { Label } from 'dome/controls/labels';
-import { Badge } from 'dome/controls/icons';
-import { Hbox, Vbox } from 'dome/layout/boxes';
-import Server from './server';
-import { Set } from 'immutable';
-
-class SelectList extends React.Component {
- render() {
- return (
- <select value={this.props.value} onChange={this.props.onChange}>
- {this.props.values.map(v => <option key={v.id}>{v.name}</option>)}
- </select>
- )
- }
-}
-
-function FileSelect(props) {
- const [files, setFiles] = useState(Set([]));
- const [addedFiles, setAddedFiles] = useState(Set([]));
- const [removedFiles, setRemovedFiles] = useState(Set([]));
-
- function updateFiles() {
- Server
- .sendGET("kernel.ast.getFiles", [], false)
- .then(
- (data) => {
- console.log("success: " + data + '\n');
- setFiles(Set(data));
- setAddedFiles(Set([]));
- setRemovedFiles(Set([]));
- },
- (_rid, data) => {
- console.log("err:" + data + '\n')
- });
- };
-
- //Done only once
- useEffect(updateFiles, []);
-
- function addFiles() {
- showOpenFiles({ message: "Add files" })
- .then(files => {
- setAddedFiles(() => {
- const sfiles = Set(files);
- const res = addedFiles.union(sfiles);
- return res
- })
- });
- };
-
- function generateItem(v) {
- const removed = removedFiles.has(v);
- const added = addedFiles.has(v);
- return (
- <Hbox key={v}>
- <Label
- style={(removed ? { color: 'red' } : (added ? { color: 'green' } : {}))}>
- {v}
- </Label>
- <Badge
- value={removed ? 'CIRC.PLUS' : 'CIRC.MINUS'}
- onClick={() =>
- setRemovedFiles(() =>
- removed ? removedFiles.remove(v) : removedFiles.add(v))
- } />
- </Hbox>
- )
- };
-
- function sendFiles() {
- const filesToSend = files.union(addedFiles).subtract(removedFiles);
- Server
- .sendSET("kernel.ast.setFiles", filesToSend.toArray(), false)
- .then(
- () => {
- console.log("setFiles: success");
- Server
- .sendEXEC("kernel.ast.execCompute", [], false)
- .then(
- () => {
- console.log("execComput: success");
- updateFiles();
- },
- (_rid, data) => {
- console.log("execCompute err:" + data + '\n')
- }
- );
- },
- (_rid, data) => {
- console.log("setFiles err:" + data + '\n')
- }
- );
- };
-
- return (
- <Vbox>
- {files.map(generateItem)}
- {addedFiles.map(generateItem)}
- <Hbox>
- <Button label='Add files' onClick={addFiles} />
- <Button label='Update' onClick={sendFiles} />
- </Hbox>
- </Vbox>
- )
-}
-
-function Projects(props) {
- const [projects, setProjects] = useState([]);
- const [current, setCurrent] = useState(undefined);
- const [newName, setNewName] = useState("project_name");
-
-
- function updateProjects() {
- Server
- .sendGET("kernel.project.getList", [], false)
- .then(
- (data) => {
- console.log("success: " + data.datadir + '\n');
- setProjects(data)
- },
- (_rid, data) => {
- console.log("err:" + data + '\n')
- });
- };
-
- //Done only once
- useEffect(updateProjects, []);
-
- function new_project() {
- Server
- .sendSET("kernel.project.setCreate", newName, false)
- .then(
- (data) => {
- console.log("success: " + data.datadir + '\n');
- updateProjects();
- },
- (_rid, data) => {
- console.log("err:" + data + '\n')
- });
- };
-
-
- console.log("projects:", projects);
- return (
- <Hbox>
- <form onSubmit={new_project}>
- <label>
- Name of new project :
- <input
- type="text"
- value={newName}
- onChange={event => setNewName(event.target.value)}
- />
- </label>
- <input type="submit" value="Create" />
- </form>
- <label>
- Current project:
- <SelectList
- values={projects}
- value={current}
- onChange={event => setCurrent(event.target.value)}
- />
- </label>
- </Hbox>
- )
-}
-
-function Kernel(props) {
- const [state, setState] = useState("undefined");
-
- function getCfg() {
- console.log("send request\n");
- Server
- .sendGET("kernel.getConfig", [], false)
- .then(
- (data) => {
- console.log("success: " + data.datadir + '\n');
- setState(data.datadir);
- },
- (_rid, data) => {
- console.log("err:" + data + '\n')
- });
- };
-
- return (
- <Hbox>
- <Button label='GetConfig' onClick={getCfg} />
- <Label label={state} />
- </Hbox>
- )
-}
-
-export default function Project(props) {
-
- return (
- <>
- <Kernel />
- <Projects />
- <FileSelect />
- </>
- )
-}
\ No newline at end of file
diff --git a/ivette/backup/sandbox/Properties.js b/ivette/backup/sandbox/Properties.js
deleted file mode 100644
index ac8e770bef928215afea13c5dc33985af090daf4..0000000000000000000000000000000000000000
--- a/ivette/backup/sandbox/Properties.js
+++ /dev/null
@@ -1,137 +0,0 @@
-// --------------------------------------------------------------------------
-// --- Frama-C Properties Table
-// --------------------------------------------------------------------------
-
-import React from 'react' ;
-import Dome from 'dome' ;
-import { useState, useEffect } from 'react' ;
-
-import { Button } from 'dome/controls/buttons';
-import { Vfill, Vbox, Scroll } from 'dome/layout/boxes' ;
-import { Splitter } from 'dome/layout/splitters' ;
-import { Column, Table } from 'dome/table/views' ;
-import { ArrayModel } from 'dome/table/arrays' ;
-import { Form, Section, FieldList, FieldCheckbox, FieldRadio } from 'dome/layout/forms' ;
-
-import Server from './server.js' ;
-import Events from './Events.js' ;
-
-export default function Properties (props) {
- const model = props.properties;
-
- /* --- Columns of the table ----------------------------------------------- */
-
- const columnFile = <Column id='file'
- label='File' />;
- const columnFct = <Column id='fct'
- label='Function' />;
- const columnProp = <Column id='property'
- label='Property'
- fill />;
- const columnStatus = <Column id='status'
- label='Status' />;
-
- /* The default columns displayed. The property column is always shown. */
- const defaultColumns =
- { path:false,
- fct:true,
- status:true,
- };
- /* The columns displayed. Set by the user through a form. */
- const [columnsValue, _] = useState(defaultColumns);
-
- /* Builds the array of columns according to [columnsValue]. */
- function makeColumns () {
- const columns = new Array();
- if (columnsValue.path)
- columns.push(columnFile);
- if (columnsValue.fct)
- columns.push(columnFct);
- columns.push(columnProp); // Always shown.
- if (columnsValue.status)
- columns.push(columnStatus);
- return columns;
- }
-
- /* The columns array used by the table. */
- const [ columns, setColumns ] = useState(makeColumns());
-
- function onChangeColumns () {
- setColumns(makeColumns());
- }
-
- /* Form to choose the columns displayed. */
- const columns_list =
- <Form value={columnsValue} onChange={onChangeColumns} >
- <Section label="Columns" unfold='false' >
- <FieldCheckbox label="File" path='path' />
- <FieldCheckbox label="Function" path='fct' />
- <FieldCheckbox label="Status" path='status' />
- </Section>
- </Form>;
-
- /* --- Filters of logical properties ------------------------------------- */
-
- /* All properties are shown by default. */
- const default_status =
- { valid:true,
- valid_hyp:true,
- unknown:true,
- invalid:true,
- invalid_hyp:true,
- considered_valid:true,
- untried:true,
- dead:true,
- inconsistent:true
- };
- const [status, setStatus] = useState(default_status);
-
- /* Function filtering the properties by status. */
- function filter (item) {
- switch (item.status) {
- case 'Valid':
- case 'Valid_but_dead': return status.valid;
- case 'Valid_under_hyp': return status.valid_hyp;
- case 'Invalid':
- case 'Invalid_but_dead': return status.invalid;
- case 'Invalid_under_hyp': return status.invalid_hyp;
- case 'Unknown':
- case 'Unknown_but_dead': return status.unknown;
- case 'Considered_valid': return status.considered_valid;
- case 'Never_tried': return status.untried;
- case 'Dead': return status.dead;
- case 'Inconsistent': return status.inconsistent;
- default: return true;
- }
- }
-
- function onChangeFilter (value, error) {
- model.setFiltering(filter);
- }
-
- /* Filters selection. */
- const filter_list =
- <Form value={status} onChange={onChangeFilter} >
- <Section label="Status" unfold='true' >
- <FieldCheckbox label="Valid" path='valid' />
- <FieldCheckbox label="Valid under hyp." path='valid_hyp' />
- <FieldCheckbox label="Unknown" path='unknown' />
- <FieldCheckbox label="Invalid" path='invalid' />
- <FieldCheckbox label="Invalid under hyp." path='invalid_hyp' />
- <FieldCheckbox label="Considered valid" path='considered_valid' />
- <FieldCheckbox label="Untried" path='untried' />
- <FieldCheckbox label="Dead" path='dead' />
- <FieldCheckbox label="Inconsistent" path='inconsistent' />
- </Section>
- </Form>;
-
- /* Table of logical properties. */
- const table = <Table model={model} children={columns} />;
-
- return (
- <Splitter dir='LEFT' >
- <Vfill> <Scroll> {filter_list} {columns_list} </Scroll> </Vfill>
- <Vfill> {table} </Vfill>
- </Splitter>
- )
-}
diff --git a/ivette/backup/sandbox/SourceCode.js b/ivette/backup/sandbox/SourceCode.js
deleted file mode 100644
index 023eeafbfb30a162fb9aebacb2217358969aec90..0000000000000000000000000000000000000000
--- a/ivette/backup/sandbox/SourceCode.js
+++ /dev/null
@@ -1,129 +0,0 @@
-// --------------------------------------------------------------------------
-// --- Frama-C Source Panel
-// -------------------------------------------------------------------------
-
-import React from 'react' ;
-import Dome from 'dome' ;
-
-import { Button } from 'dome/controls/buttons';
-import Toolbar from 'dome/layout/toolbars' ;
-import { Hbox, Hfill, Vbox, Vfill, Space } from 'dome/layout/boxes' ;
-import { Splitter } from 'dome/layout/splitters' ;
-import { Column, Table } from 'dome/table/views' ;
-import { Text } from 'dome/text/editors' ;
-import Server from './server.js' ;
-import Events from './Events.js' ;
-
-import { useState, useEffect } from 'react' ;
-
-import 'codemirror/mode/clike/clike.js';
-import 'codemirror/theme/ambiance.css' ;
-import 'codemirror/theme/solarized.css';
-
-/* Pretty prints the source code from [text] in [buffer]. */
-function printSource (buffer, text) {
- if (text === null) return;
- if (Array.isArray(text)) {
- const tag = text.shift();
- if (tag !== '') {
- buffer.openTextMarker( { id:tag } );
- text.forEach(txt => printSource(buffer, txt));
- buffer.closeTextMarker();
- } else
- text.forEach(txt => printSource(buffer, txt));
- } else
- buffer.append(text);
-}
-
-/* Display the list of functions and the source code for the selected function
- in the list. */
-export default function Source (props) {
- /* Buffer for the source code. */
- const buffer = props.sourceCode;
- /* Model for the function list. */
- const model = props.functions;
-
- /* Print the source code of the function [data.fct]. */
- function printFunction (data) {
- console.log("Select function: " + data.fct);
- Server.sendGET("kernel.ast.printFunction", data.fct, false).then
- ( data => {
- buffer.clear();
- printSource(buffer, data);
- });
- }
-
- const [ theme, setTheme ] = useState('default');
- function selectTheme (name) {
- return function () { setTheme(name); }
- }
-
- function contextMenu (data) {
- const item1 = { label:"Default", onClick:selectTheme("default") };
- const item2 = { label:"Ambiance", onClick:selectTheme("ambiance") };
- const item3 = { label:"Solarized light", onClick:selectTheme("solarized light") };
- const item4 = { label:"Solarized dark", onClick:selectTheme("solarized dark") };
- Dome.popupMenu([item1, item2, item3, item4]).catch(() => {});
- }
-
- /* Table for the function list. */
- const table =
- <Table model={model}
- onSelection={printFunction} >
- <Column id='fct'
- label='Functions'
- title='List of functions in the current Frama-C project' />
- </Table>;
-
- const [ lineWrapping, setLineWrapping ] = useState(false);
- function changeLineWrapping () { setLineWrapping(!lineWrapping); }
-
- const code = <Text buffer={buffer}
- mode='text/x-csrc'
- theme={theme}
- lineWrapping={lineWrapping}
- readOnly />;
-
- const [ fontSize, setFontSize ] = useState(12);
- function increaseFontSize () { setFontSize(fontSize + 2); }
- function decreaseFontSize () { setFontSize(fontSize - 2); }
-
- const toolbar =
- <Toolbar.ToolBar>
- <Toolbar.Space/>
- <Toolbar.Select
- value={theme}
- onChange={(name) => {selectTheme(name)();}} >
- <option value='default' label='Default'/>
- <option value='ambiance' label='Ambiance'/>
- <option value='solarized light' label='Solarized light'/>
- <option value='solarized dark' label='Solarized dark'/>
- </Toolbar.Select>
- <Toolbar.ButtonGroup>
- <Toolbar.Button
- icon='MINUS'
- title='Decrease the font size'
- onClick={decreaseFontSize}
- />
- <Toolbar.Button
- icon='PLUS'
- title='Increase the font size'
- onClick={increaseFontSize}
- />
- </Toolbar.ButtonGroup>
- <Toolbar.Button icon={lineWrapping ? "CHECK" : "CROSS"}
- label="Line wrapping"
- title="Change line wrapping mode"
- onClick={changeLineWrapping} />
- </Toolbar.ToolBar>;
-
- return (
- <Splitter dir='LEFT' >
- <Vfill style={{ minWidth: 100 }}> {table} </Vfill>
- <Vfill onContextMenu={contextMenu} style={{ fontSize: fontSize }} >
- {toolbar}
- {code}
- </Vfill>
- </Splitter>
- );
-}
diff --git a/ivette/backup/sandbox/SourceFiles.js b/ivette/backup/sandbox/SourceFiles.js
deleted file mode 100644
index 8a7386b57064bb60670ecca9b6145651e6b236c5..0000000000000000000000000000000000000000
--- a/ivette/backup/sandbox/SourceFiles.js
+++ /dev/null
@@ -1,44 +0,0 @@
-import React, { useState, useEffect } from 'react';
-import { Buffer } from 'dome/text/buffers'
-import { Text } from 'dome/text/editors';
-import Server from './server';
-import System from 'dome/system';
-import 'codemirror/mode/clike/clike.js';
-
-export default function SourceFiles() {
-
- const [filenames, setFilenames] = useState([]);
- const buffer = new Buffer({ mode: 'text/x-csrc' });
-
- function getSourceFilenames() {
- console.log('SourceFiles::getFiles');
-
- Server
- .sendGET("kernel.ast.getFiles", [], false)
- .then(
- (fnames) => {
- console.log('Got source filenames:' + fnames);
- setFilenames(fnames);
- });
- }
-
- useEffect(getSourceFilenames, []);
-
- useEffect(() => {
- if (filenames.length > 0) {
- console.log('Displaying ' + filenames[0] + '!');
- System
- .readFile(filenames[0])
- .then(
- (fcontent) => {
- console.log('Got file content: ' + fcontent);
- buffer.clear();
- buffer.append(fcontent);
- });
- }
- }, [filenames])
-
- return (
- <Text buffer={buffer} readOnly='true' lineNumbers='true' />
- )
-}
diff --git a/ivette/package.json b/ivette/package.json
index d77d420e12005ff11011b27dd7bca04d6531db44..c86d31fa83b3763daf8f92c58127c066a9dce062 100644
--- a/ivette/package.json
+++ b/ivette/package.json
@@ -39,15 +39,14 @@
"eslint-config-airbnb": "^18.1.0",
"eslint-config-airbnb-typescript": "^7.2.1",
"eslint-plugin-import": "^2.20.2",
- "eslint-plugin-jsx-a11y": "^6.2.3",
+ "eslint-plugin-jsx-a11y": "^6.3.0",
"eslint-plugin-react": "^7.19.0",
"eslint-plugin-react-hooks": "^3.0.0",
"html-loader": "1.0.0-alpha.0",
"jsdoc": "^3.6.3",
- "react-fast-compare": "^3.2.0",
"react-hot-loader": "^4.12.20",
"serve": "^11.3.0",
- "typedoc": "^0.17.6",
+ "typedoc": "^0.17.8",
"typedoc-plugin-external-module-name": "^3.1.0",
"typescript": "^3.8.3",
"webpack": "^4.41.4"
@@ -60,6 +59,7 @@
"react": "^16.8",
"react-dom": "^16.13.1",
"react-draggable": "^4.2.0",
+ "react-fast-compare": "^3.2.0",
"react-virtualized": "^9.21.2",
"source-map-support": "^0.5.16",
"zeromq": "^6.0.0-beta.5"
diff --git a/ivette/src/dome/src/main/dome.js b/ivette/src/dome/src/main/dome.js
index 1385eb6bc5e50f273d46a85201ae79d68e74e093..cd01363afb0b82961da1f77f1baed2b3865e5b7c 100644
--- a/ivette/src/dome/src/main/dome.js
+++ b/ivette/src/dome/src/main/dome.js
@@ -50,83 +50,136 @@ export const platform = System.platform ;
// --- Settings
// --------------------------------------------------------------------------
-const APP_DIR = app.getPath('userData');
-const APP_SETTINGS = path.join( APP_DIR , 'Settings.json' );
-
-var s_frames = {} ;
-var s_globals = {} ;
-var s_application = {} ;
-var s_preferences = {} ;
+function loadSettings( file ) {
+ try {
+ if (!fstat(file))
+ return {};
+ const text = fs.readFileSync(file, { encoding: 'utf8' } );
+ return Object.assign({}, JSON.parse(text));
+ } catch(err) {
+ console.error("[Dome] Unable to load settings", file, err);
+ return {};
+ }
+}
-function loadSettings() {
+function saveSettings( file, data={} ) {
try {
- if (!fstat( APP_SETTINGS )) return;
- const content = fs.readFileSync( APP_SETTINGS, { encoding: 'utf8' } );
- const loaded = JSON.parse( content );
- const MERGE = (store,field) => _.merge( store , _.get( loaded , field ));
- s_frames = MERGE( s_frames , 'frames' );
- s_globals = MERGE( s_globals, 'globals' );
- s_application = MERGE( s_application, 'application' );
- s_preferences = MERGE( s_preferences, 'preferences' );
+ const text = JSON.stringify( data, undefined, DEVEL ? 2 : 0 );
+ fs.writeFileSync( file, text, { encoding: 'utf8' }, (err) => { throw(err); } );
} catch(err) {
- console.error("[Dome] Can not load application settings\n" + err);
+ console.error("[Dome] Unable to save settings", file, err);
}
}
-function saveSettings() {
+// --------------------------------------------------------------------------
+// --- Global Settings
+// --------------------------------------------------------------------------
+
+var GlobalSettings; // Current Dictionnary
+
+const APP_DIR = app.getPath('userData');
+const PATH_WINDOW_SETTINGS = path.join( APP_DIR, 'WindowSettings.json' );
+const PATH_GLOBAL_SETTINGS = path.join( APP_DIR, 'GlobalSettings.json' );
+
+function saveGlobalSettings() {
try {
if (!fstat( APP_DIR )) fs.mkdirSync( APP_DIR );
- const saved = {
- globals: s_globals,
- application: s_application,
- preferences: s_preferences,
- frames: s_frames
- };
- const content = JSON.stringify( saved, undefined, DEVEL ? 2 : 0 );
- fs.writeFileSync( APP_SETTINGS, content, { encoding: 'utf8' }, errorSettings );
+ saveSettings( PATH_GLOBAL_SETTINGS, GlobalSettings );
} catch(err) {
- errorSettings(err);
+ console.error("[Dome] Unable to save global settings", err);
}
}
-const fireSaveSettings = _.debounce( saveSettings , 50 );
+function obtainGlobalSettings() {
+ if (!GlobalSettings) {
+ GlobalSettings = loadSettings( PATH_GLOBAL_SETTINGS );
+ }
+ return GlobalSettings;
+}
+
+// --------------------------------------------------------------------------
+// --- Window Settings & Frames
+// --------------------------------------------------------------------------
-function errorSettings(err) {
- if (err) console.error("[Dome] Can not save application settings\n" + err);
+/* Window Handle:
+ {
+ window: BrowserWindow ; // Also prevents Gc
+ config: path; // Path to config file
+ frame: { x,y,w,h }; // Frame position
+ settings: object; // Current settings
+ reload: boolean; // Reloaded window
+ }
+ */
+
+const WindowHandles = {}; // Indexed by *webContents* id
+
+function saveWindowConfig(handle) {
+ const settings = {
+ frame: handle.frame,
+ settings: handle.settings,
+ devtools: handle.devtools
+ };
+ saveSettings( handle.config, settings );
}
-function remoteSyncSettings(event)
-{
- const isSetting = windowSettings && windowSettings.id === event.frameId ;
+function windowSyncSettings(event) {
+ const handle = WindowHandles[event.sender.id];
event.returnValue = {
- globals: s_globals,
- settings: isSetting ? s_preferences : s_application
+ globals: obtainGlobalSettings(),
+ settings: handle && handle.settings
};
}
-function remoteSaveWindowSettings(event,patches)
-{
- const isSetting = windowSettings && windowSettings.id === event.frameId ;
- _.merge( isSetting ? s_preferences : s_application , patches );
- saveSettings();
+ipcMain.on('dome.ipc.settings.sync', windowSyncSettings );
+
+// --------------------------------------------------------------------------
+// --- Patching Settings
+// --------------------------------------------------------------------------
+
+function applyPatches( data, args ) {
+ args.forEach(({ key, value }) => {
+ if (value === null) {
+ delete data[key];
+ } else {
+ data[key] = value;
+ }
+ });
}
-function remoteSaveGlobalSettings(event,patches)
-{
- _.merge( s_globals , patches );
- saveSettings();
- BrowserWindow.getAllWindows().forEach((win) => {
- if (win.id !== event.frameId)
- win.send('dome.ipc.settings.update',patches);
+function applyWindowSettings(event,args) {
+ const handle = WindowHandles[event.sender.id];
+ if (handle) {
+ applyPatches( handle.settings, args );
+ if (DEVEL) saveWindowConfig( handle );
+ }
+}
+
+function applyGlobalSettings(event,args) {
+ applyPatches( obtainGlobalSettings(), args );
+ BrowserWindow.getAllWindows().forEach((w) => {
+ if (w.webContents.id !== event.sender.id) {
+ w.send('dome.ipc.settings.update',args);
+ }
});
+ if (DEVEL) saveGlobalSettings();
}
-ipcMain.on('dome.ipc.settings.sync', remoteSyncSettings );
-ipcMain.on('dome.ipc.settings.window', remoteSaveWindowSettings );
-ipcMain.on('dome.ipc.settings.global', remoteSaveGlobalSettings );
+ipcMain.on('dome.ipc.settings.window', applyWindowSettings );
+ipcMain.on('dome.ipc.settings.global', applyGlobalSettings );
// --------------------------------------------------------------------------
-// --- Active Windows
+// --- Renderer-Process Communication
+// --------------------------------------------------------------------------
+
+function broadcast( event, ...args )
+{
+ BrowserWindow.getAllWindows().forEach((w) => {
+ w.send( event, ...args );
+ });
+}
+
+// --------------------------------------------------------------------------
+// --- Window Activities
// --------------------------------------------------------------------------
var appName = 'Dome' ;
@@ -141,21 +194,24 @@ export function setName(title) {
}
function setTitle(event,title) {
- let w = BrowserWindow.fromId( event.frameId );
- w.setTitle( title || appName );
+ let handle = WindowHandles[event.sender.id];
+ handle && handle.setTitle( title || appName );
}
function setModified(event,modified) {
- let w = BrowserWindow.frameId( event.frameId );
- if (platform == 'macos')
- w.setDocumentEdited( modified );
- else {
- let title = w.getTitle();
- if (title.startsWith(MODIFIED))
- title = title.substring(MODIFIED.length);
- if (modified)
- title = MODIFIED + title ;
- w.setTitle(title);
+ let handle = WindowHandles[event.sender.id];
+ if (handle) {
+ const w = handle.window;
+ if (platform == 'macos')
+ w.setDocumentEdited( modified );
+ else {
+ let title = w.getTitle();
+ if (title.startsWith(MODIFIED))
+ title = title.substring(MODIFIED.length);
+ if (modified)
+ title = MODIFIED + title ;
+ w.setTitle(title);
+ }
}
}
@@ -192,34 +248,55 @@ function navigateURL( event , url ) {
}
// --------------------------------------------------------------------------
-// --- Browser Window SetUp
+// --- Lookup for config file
// --------------------------------------------------------------------------
-const windowsHandle = {} ; // Prevent live windows to be garbage collected
-const windowsReload = {} ; // Reloaded windows
+function lookupConfig(wdir) {
+ let cwd = wdir = path.resolve(wdir);
+ let cfg = '.' + appName.toLowerCase();
+ for(;;) {
+ const here = path.join(cwd,cfg);
+ if (fstat(here)) return here;
+ let up = path.dirname(cwd);
+ if (up === cwd) break;
+ cwd = up;
+ }
+ const home = path.resolve(app.getPath('home'));
+ const user = wdir.startsWith(home) ? wdir : home ;
+ return path.join( user, cfg );
+}
+
+// --------------------------------------------------------------------------
+// --- Browser Window SetUp
+// --------------------------------------------------------------------------
-function createBrowserWindow( config, isMain=true )
+function createBrowserWindow( config, argv, wdir )
{
- const argv = isMain
+ const isAppWindow = (argv !== undefined && wdir !== undefined);
+
+ const browserArguments = isAppWindow
? SYS.WINDOW_APPLICATION_ARGV
: SYS.WINDOW_PREFERENCES_ARGV ;
- const options = _.merge(
+ const options = Object.assign(
{
show: false,
backgroundColor: '#f0f0f0',
webPreferences: {
nodeIntegration:true,
- additionalArguments: [ argv ]
+ additionalArguments: [ browserArguments ]
}
- }
- , config );
+ },
+ config
+ );
- const frameId = isMain ? 'application' : 'preferences' ;
- const frame = _.get( s_frames, frameId );
- const getInt = (v) => v && _.toSafeInteger(v);
+ const configFile = isAppWindow ? lookupConfig( wdir ) : PATH_WINDOW_SETTINGS ;
+ const configData = loadSettings( configFile );
+
+ const { frame, devtools, settings={} } = configData;
if (frame) {
+ const getInt = (v) => v && _.toSafeInteger(v);
options.x = getInt(frame.x);
options.y = getInt(frame.y);
options.width = getInt(frame.width);
@@ -227,8 +304,25 @@ function createBrowserWindow( config, isMain=true )
}
const theWindow = new BrowserWindow( options );
- const wid = theWindow.id;
-
+ const wid = theWindow.webContents.id;
+
+ const handle = {
+ window: theWindow,
+ config: configFile,
+ frame, settings, devtools,
+ reload: false
+ };
+
+ // Keep the window reference (prevent garbage collection)
+ WindowHandles[wid] = handle;
+
+ // Emitted when the window is closed.
+ theWindow.on('closed', () => {
+ saveWindowConfig(handle);
+ // Dereference the window object (allow garbage collection)
+ delete WindowHandles[wid] ;
+ });
+
// Load the index.html of the app.
if (DEVEL || LOCAL)
process.env['ELECTRON_DISABLE_SECURITY_WARNINGS'] = 'true';
@@ -239,7 +333,7 @@ function createBrowserWindow( config, isMain=true )
theWindow.once('ready-to-show' , () => {
if (DEVEL || LOCAL)
process.env['ELECTRON_DISABLE_SECURITY_WARNINGS'] = 'false';
- if (DEVEL)
+ if (DEVEL && devtools)
theWindow.openDevTools();
theWindow.show();
});
@@ -251,57 +345,44 @@ function createBrowserWindow( config, isMain=true )
// URL Navigation
theWindow.webContents.on('will-navigate', navigateURL );
theWindow.webContents.on('did-navigate-in-page', navigateURL );
+
+ // Application Startup
theWindow.webContents.on('did-finish-load', () => {
- const isLoaded = windowsReload[wid];
- if (!isLoaded) {
- windowsReload[wid] = true;
+ if (!handle.reload) {
+ handle.reload = true;
} else {
broadcast('dome.ipc.reload');
}
+ theWindow.send('dome.ipc.command',argv,wdir);
});
// Emitted when the window want's to close.
theWindow.on('close', (evt) => {
+ handle.frame = theWindow.getBounds();
+ handle.devtools = theWindow.isDevToolsOpened();
theWindow.send('dome.ipc.closing');
- const frame = theWindow.getBounds();
- _.set( s_frames, frameId , frame );
});
// Keep track of frame positions (in DEVEL)
if (DEVEL) {
- const reframe = _.debounce( (evt) => {
- const frame = theWindow.getBounds();
- _.set( s_frames, frameId , frame );
- saveSettings();
+ const saveFrame = _.debounce( (evt) => {
+ handle.frame = theWindow.getBounds();
+ handle.devtools = theWindow.isDevToolsOpened();
+ saveWindowConfig(handle);
} , 300);
- theWindow.on('resize',reframe);
- theWindow.on('moved',reframe);
+ theWindow.on('resize',saveFrame);
+ theWindow.on('moved',saveFrame);
}
- // Keep the window reference to prevent destruction
- windowsHandle[ wid ] = theWindow ;
-
- // Emitted when the window is closed.
- theWindow.on('closed', () => {
- // Dereference the window object to actually destroy it
- delete windowsHandle[ wid ] ;
- });
-
return theWindow ;
}
// --------------------------------------------------------------------------
-// --- Application Window(s)
+// --- Application Window(s) & Command Line
// --------------------------------------------------------------------------
-function filterArgv( argv ) {
- return argv.slice( DEVEL ? 3 : (LOCAL ? 2 : 1) ).filter((p) => p);
-}
-
-function sendCommand( win, argv, wdir ) {
- win.webContents.on('did-finish-load', () => {
- win.webContents.send('dome.ipc.command',argv,wdir);
- });
+function stripElectronArgv( argv ) {
+ return argv.slice( DEVEL ? 3 : (LOCAL ? 2 : 1) ).filter((p) => !!p);
}
function createPrimaryWindow()
@@ -309,31 +390,28 @@ function createPrimaryWindow()
// Initialize Menubar
Menubar.install();
- // Initialize Settings
- loadSettings();
-
// React Developper Tools
if (DEVEL)
installExtension(REACT_DEVELOPER_TOOLS,true);
-
- const primary = createBrowserWindow({ title: appName } , true);
- const wdir = process.cwd() === '/' ? app.getPath('home') : process.cwd() ;
- sendCommand( primary , filterArgv(process.argv) , wdir );
+ const cwd = process.cwd();
+ const wdir = cwd === '/' ? app.getPath('home') : cwd ;
+ const argv = stripElectronArgv(process.argv);
+ createBrowserWindow({ title: appName } , argv, wdir );
}
var appCount = 1;
-function createSecondaryWindow(_event,argv,wdir)
+function createSecondaryWindow(_event,process_argv,wdir)
{
- const secondary = createBrowserWindow({ title: `${appName} #${++appCount}` }, true);
- sendCommand( secondary, filterArgv(argv), wdir );
+ const argv = stripElectronArgv(process_argv);
+ createBrowserWindow({ title: `${appName} #${++appCount}` }, argv, wdir);
}
function createDesktopWindow()
{
const instance = appCount++ ;
- const secondary = createBrowserWindow({ title: `${appName} #${++appCount}` }, true);
- sendCommand( secondary , [] , app.getPath('home') );
+ const wdir = app.getPath('home');
+ createBrowserWindow({ title: `${appName} #${++appCount}` }, [], wdir);
}
// --------------------------------------------------------------------------
@@ -361,31 +439,35 @@ function activateWindows() {
// --- Settings Window
// --------------------------------------------------------------------------
-var windowSettings = undefined ; // Preference Window
+var PreferenceWindow = undefined ; // Preference Window
function showSettingsWindow()
{
- if (!windowSettings)
- windowSettings = createBrowserWindow({
+ if (!PreferenceWindow)
+ PreferenceWindow = createBrowserWindow({
title: appName + ' Settings',
width: 256,
height: 248,
fullscreen: false,
maximizable: false,
minimizable: false
- }, false);
- windowSettings.show();
- windowSettings.on('closed',() => windowSettings = undefined);
+ });
+ PreferenceWindow.show();
+ PreferenceWindow.on('closed',() => PreferenceWindow = undefined);
}
function restoreDefaultSettings()
{
- s_globals = {} ;
- s_preferences = {} ;
- s_application = {} ;
- s_frames = {} ;
- fireSaveSettings();
- fireSaveSettings.flush();
+ GlobalSettings = {};
+ if (DEVEL) saveGlobalSettings();
+
+ _.forEach( WindowHandles, (handle) => {
+ // Keep frame for user comfort
+ handle.settings = {};
+ handle.devtools = handle.window.isDevToolsOpened();
+ if (DEVEL) saveWindowConfig(handle);
+ });
+
broadcast( 'dome.ipc.settings.defaults' );
}
@@ -402,22 +484,21 @@ export function start() {
// Change default locale
app.commandLine.appendSwitch('lang','en');
- // Listen to window events
+ // Listen to application events
app.on( 'ready', createPrimaryWindow ); // Wait for Electron init
app.on( 'activate', activateWindows ); // Mac OSX response to dock
app.on( 'second-instance', createSecondaryWindow );
app.on( 'dome.menu.settings', showSettingsWindow );
app.on( 'dome.menu.defaults', restoreDefaultSettings );
- // Performing on-exit callbacks
+ // At-exit callbacks
app.on( 'will-quit' , () => {
+ saveGlobalSettings();
System.doExit() ;
- fireSaveSettings();
- fireSaveSettings.flush();
});
- // On OS X menu bar stay active until the user quits explicitly from menu.
- // On other systems, quit when all windows are closed.
+ // On macOS the menu bar stays active until the user explicitly quits.
+ // On other systems, automatically quit when all windows are closed.
// Warning: when no event handler is registered, the app automatically
// quit when all windows are closed.
app.on( 'window-all-closed', () => {
@@ -426,17 +507,6 @@ export function start() {
}
-// --------------------------------------------------------------------------
-// --- Renderer-Process Communication
-// --------------------------------------------------------------------------
-
-function broadcast( event, ...args )
-{
- BrowserWindow.getAllWindows().forEach((w) => {
- w.send( event, ...args );
- });
-}
-
// --------------------------------------------------------------------------
// --- MenuBar Management
// --------------------------------------------------------------------------
diff --git a/ivette/src/dome/src/misc/plugins.js b/ivette/src/dome/src/misc/plugins.js
index 5d468d4017a308f65f0dfad93f3ef2dcc6c17aea..87a08c0c836e960d70158825db1a98a685f2282c 100644
--- a/ivette/src/dome/src/misc/plugins.js
+++ b/ivette/src/dome/src/misc/plugins.js
@@ -34,7 +34,7 @@ export function install( name )
let config ;
try { config = JSON.pargse(fs.readFileSync( pkg , 'UTF-8' )); }
catch(err) {
- console.error( `[Dome] reading '${pkg}':\n`, err );
+ console.error( `[Dome] Reading '${pkg}':\n`, err );
throw `Plugin '${name}' has invalid 'package.json' file` ;
}
@@ -49,7 +49,7 @@ export function install( name )
let bundle ;
try { bundle = fs.readFileSync( bundlejs , 'UTF-8' ); }
catch(err) {
- console.error( `[Dome] loading '${bundlejs}':\n`, err );
+ console.error( `[Dome] Loading '${bundlejs}':\n`, err );
throw `Plugin '${name}' can not load its entry point` ;
}
@@ -63,7 +63,7 @@ export function install( name )
let module = { id, exports };
compiled( module, require, static_d );
} catch(err) {
- console.error( `[Dome] running '${bundlejs}':\n`, err );
+ console.error( `[Dome] Running '${bundlejs}':\n`, err );
throw `Plugin '${name}' can not install bundle` ;
}
register( id, exports ); // final exports
diff --git a/ivette/src/dome/src/misc/system.js b/ivette/src/dome/src/misc/system.js
index 48808f72562593c59043fcd977d147a4f5abee93..3a4deac841f74817b387562192b72de5108edd91 100644
--- a/ivette/src/dome/src/misc/system.js
+++ b/ivette/src/dome/src/misc/system.js
@@ -593,7 +593,7 @@ export function spawn(command,args,options) {
}
if ( !process ) {
- throw "[Dome] Can not create process ('"+command+"')";
+ throw `[Dome] Unable to create process ('${command}')`;
return;
}
diff --git a/ivette/src/dome/src/renderer/controls/buttons.tsx b/ivette/src/dome/src/renderer/controls/buttons.tsx
index da254148990e172ace57336361370f2a9fb42bf1..0789962f9c941cebc455ec5c53ea11d0b2cce94d 100644
--- a/ivette/src/dome/src/renderer/controls/buttons.tsx
+++ b/ivette/src/dome/src/renderer/controls/buttons.tsx
@@ -161,8 +161,6 @@ export function Button(props: ButtonProps) {
+ (display ? '' : ' dome-control-erased')
+ (className ? ' ' + className : '');
const nofocus = focusable ? undefined : true;
- console.log('ICON', Icon);
- console.log('LABEL', LABEL);
return (
<button type='button'
className={theClass}
diff --git a/ivette/src/dome/src/renderer/data/compare.ts b/ivette/src/dome/src/renderer/data/compare.ts
index 6dcbec1d018875f4d3eceff7f1eafb345d04b700..31185f33ee006c019b53b8438c9f1b3f390ef10e 100644
--- a/ivette/src/dome/src/renderer/data/compare.ts
+++ b/ivette/src/dome/src/renderer/data/compare.ts
@@ -8,6 +8,8 @@
@module dome/data/compare
*/
+import FastCompare from 'react-fast-compare';
+
/**
Interface for comparison functions.
These function shall fullfill the following contract:
@@ -22,11 +24,19 @@ export interface Order<A> {
(x: A, y: A): number;
}
+/**
+ Deep structural equality.
+ Provided by [react-fast-compare]().
+*/
+export const isEqual = FastCompare;
+
+/** Always returns 0. */
export function equal(_x: any, _y: any): 0 { return 0; }
+/** Primitive comparison works on this type. */
export type bignum = bigint | number;
-/** Non-NaN numbers and big-ints */
+/** Detect Non-NaN numbers and big-ints. */
export function isBigNum(x: any): x is bignum {
return typeof (x) === 'bigint' || (typeof (x) === 'number' && !Number.isNaN(x));
}
@@ -121,8 +131,24 @@ export function array<A>(order: Order<A>): Order<A[]> {
};
}
+/** Order by dictionary order.
+ Can be used directly with an enum type declaration.
+ */
+export function byEnum<A extends string>(d: { [key: string]: A }): Order<A> {
+ const ranks: { [index: string]: number } = {};
+ const values = Object.keys(d);
+ const wildcard = values.length;
+ values.forEach((C, k) => ranks[C] = k);
+ return (x: A, y: A) => {
+ if (x === y) return 0;
+ const rx = ranks[x] ?? wildcard;
+ const ry = ranks[y] ?? wildcard;
+ return rx - ry;
+ };
+}
+
/** Order string enumeration constants.
- `enums(v1,...,vN)` will order constant following the order of arguments.
+ `byRank(v1,...,vN)` will order constant following the order of arguments.
Non-listed constants appear at the end, or at the rank specified by `'*'`. */
export function byRank(...args: string[]): Order<string> {
const ranks: { [index: string]: number } = {};
@@ -157,7 +183,7 @@ export function getKeys<T>(a: T): (keyof T)[] {
/**
Maps each field of `A` to some _optional_ comparison of the associated type.
Hence, `ByFields<{…, f: T, …}>` is `{…, f?: Order<T>, …}`.
- See [[fields]] comparison function.
+ See [[byFields]] comparison function.
*/
export type ByFields<A> = {
[P in keyof A]?: Order<A[P]>;
@@ -166,7 +192,7 @@ export type ByFields<A> = {
/**
Maps each field of `A` to some comparison of the associated type.
Hence, `ByAllFields<{…, f: T, …}>` is `{…, f: Order<T>, …}`.
- See [[fieldsComplete]] comparison function.
+ See [[byAllFields]] comparison function.
*/
export type ByAllFields<A> = {
[P in keyof A]: Order<A[P]>;
@@ -222,6 +248,34 @@ export function byAllFields<A>(order: ByAllFields<A>): Order<A> {
};
}
+export type dict<A> = undefined | null | { [key: string]: A };
+
+/**
+ Compare dictionaries _wrt_ lexicographic order of entries.
+*/
+export function dictionary<A>(order: Order<A>): Order<dict<A>> {
+ return (x: dict<A>, y: dict<A>) => {
+ if (x === y) return 0;
+ const dx = x ?? {};
+ const dy = y ?? {};
+ const phi = option(order);
+ const fs = Object.getOwnPropertyNames(dx).sort();
+ const gs = Object.getOwnPropertyNames(dy).sort();
+ const p = fs.length;
+ const q = gs.length;
+ for (let i = 0, j = 0; i < p && j < q;) {
+ let a = undefined, b = undefined;
+ const f = fs[i];
+ const g = gs[j];
+ if (f <= g) { a = dx[f]; i++; }
+ if (g <= f) { b = dy[g]; j++; }
+ const cmp = phi(a, b);
+ if (cmp != 0) return cmp;
+ }
+ return p - q;
+ };
+}
+
/** Pair comparison. */
export function pair<A, B>(ordA: Order<A>, ordB: Order<B>): Order<[A, B]> {
return (u, v) => {
diff --git a/ivette/src/dome/src/renderer/data/json.ts b/ivette/src/dome/src/renderer/data/json.ts
new file mode 100644
index 0000000000000000000000000000000000000000..ba0be2fc66fcef5b3a37e5e436633d1f4ebfba3f
--- /dev/null
+++ b/ivette/src/dome/src/renderer/data/json.ts
@@ -0,0 +1,489 @@
+// --------------------------------------------------------------------------
+// --- JSON Utilities
+// --------------------------------------------------------------------------
+
+/**
+ Safe JSON utilities.
+ @packageDocumentation
+ @module dome/data/json
+*/
+
+import { DEVEL } from 'dome/system';
+
+export type json =
+ undefined | null | number | string | json[] | { [key: string]: json }
+
+/**
+ Parse without _revivals_.
+ Returned data is guaranteed to have only [[json]] type.
+ If an error occurs and `noError` is set to `true`,
+ the function returns `undefined` and logs the error in console
+ (DEVEL mode only).
+ */
+export function parse(text: string, noError = false): json {
+ if (noError) {
+ try {
+ return JSON.parse(text);
+ } catch (err) {
+ if (DEVEL) console.error('[Dome.json] Invalid format:', err);
+ return undefined;
+ }
+ } else
+ return JSON.parse(text);
+}
+
+/**
+ Export JSON (or any data) as a compact string.
+*/
+export function stringify(js: any) {
+ return JSON.stringify(js, undefined, 0);
+}
+
+/**
+ Export JSON (or any data) as a string with indentation.
+ */
+export function pretty(js: any) {
+ return JSON.stringify(js, undefined, 2);
+}
+
+// --------------------------------------------------------------------------
+// --- SAFE Decoder
+// --------------------------------------------------------------------------
+
+/** Decoder for values of type `D`.
+ You can abbreviate `Safe<D | undefined>` with `Loose<D>`. */
+export interface Safe<D> {
+ (js?: json): D;
+}
+
+/** Decoder for values of type `D`, if any.
+ Same as `Safe<D | undefined>`. */
+export interface Loose<D> {
+ (js?: json): D | undefined;
+}
+
+/**
+ Encoder for value of type `D`.
+ In most cases, you only need [[identity]].
+ */
+export interface Encoder<D> {
+ (v: D): json;
+}
+
+/** Can be used for most encoders. */
+export function identity<A>(v: A): A { return v; };
+
+// --------------------------------------------------------------------------
+// --- Primitives
+// --------------------------------------------------------------------------
+
+/** Always returns `undefined` on any input. */
+export const jNull: Safe<undefined> = (_: json) => undefined;
+
+/** Identity. */
+export const jAny: Safe<json> = (js: json) => js;
+
+/** Primitive JSON number or `undefined`. */
+export const jNumber: Loose<number> = (js: json) => (
+ typeof js === 'number' && !Number.isNaN(js) ? js : undefined
+);
+
+/** Primitive JSON number, rounded to integer, or `undefined`. */
+export const jInt: Loose<number> = (js: json) => (
+ typeof js === 'number' && !Number.isNaN(js) ? Math.round(js) : undefined
+);
+
+/** Primitive JSON number or `0`. */
+export const jZero: Safe<number> = (js: json) => (
+ typeof js === 'number' && !Number.isNaN(js) ? js : 0
+);
+
+/** Primitive JSON boolean or `undefined`. */
+export const jBoolean: Loose<boolean> = (js: json) => (
+ typeof js === 'boolean' ? js : undefined
+);
+
+/** Primitive JSON boolean or `true`. */
+export const jTrue: Safe<boolean> = (js: json) => (
+ typeof js === 'boolean' ? js : true
+);
+
+/** Primitive JSON boolean or `false`. */
+export const jFalse: Safe<boolean> = (js: json) => (
+ typeof js === 'boolean' ? js : false
+);
+
+/** Primitive JSON string or `undefined`. */
+export const jString: Loose<string> = (js: json) => (
+ typeof js === 'string' ? js : undefined
+);
+
+/**
+ Lookup tags in a dictionary.
+ Can be used directly for enum types, eg. `jEnum(myEnumType)`.
+ */
+export function jEnum<A>(d: { [tag: string]: A }): Loose<A> {
+ return (v: json) => typeof v === 'string' ? d[v] : undefined;
+}
+
+/**
+ One of the enumerated _constants_ or `undefined`.
+ The typechecker will prevent you from listing values that are not in
+ type `A`. However, it will not protected you from missings constants in `A`.
+*/
+export function jTags<A>(...values: ((string | number) & A)[]): Loose<A> {
+ var m = new Map<string | number, A>();
+ values.forEach(v => m.set(v, v));
+ return (v: json) => (typeof v === 'string' ? m.get(v) : undefined);
+}
+
+/**
+ Refine a loose decoder with some default value.
+ The default value is returned when the provided JSON is `undefined` or
+ when the loose decoder returns `undefined`.
+ */
+export function jDefault<A>(
+ fn: Loose<A>,
+ defaultValue: A,
+): Safe<A> {
+ return (js: json) =>
+ js === undefined ? defaultValue : (fn(js) ?? defaultValue);
+}
+
+/**
+ Force returning `undefined` or a default value for `undefined` _or_ `null` JSON input.
+ Typically useful to leverage an existing `Safe<A>` decoder.
+ */
+export function jOption<A>(fn: Safe<A>, defaultValue?: A): Loose<A> {
+ return (js: json) => (js === undefined || js === null ? defaultValue : fn(js));
+}
+
+/**
+ Fail when the loose decoder returns `undefined`.
+ See also [[jCatch]] and [[jTry]].
+ */
+export function jFail<A>(fn: Loose<A>, error: string | Error): Safe<A> {
+ return (js: json) => {
+ const d = fn(js);
+ if (d !== undefined) return d;
+ throw error;
+ };
+}
+
+/**
+ Provide a fallback value in case of undefined value or error.
+ See also [[jFail]] and [[jTry]].
+ */
+export function jCatch<A>(fn: Loose<A>, fallBack: A): Safe<A> {
+ return (js: json) => {
+ try {
+ return fn(js) ?? fallBack;
+ } catch (err) {
+ if (DEVEL) console.error('[Dome.json]', err);
+ return fallBack;
+ }
+ };
+}
+
+/**
+ Provides an (optional) default value in case of error or undefined value.
+ See also [[jFail]] and [[jCatch]].
+ */
+export function jTry<A>(fn: Loose<A>, defaultValue?: A): Loose<A> {
+ return (js: json) => {
+ try {
+ return fn(js) ?? defaultValue;
+ } catch (_err) {
+ return defaultValue;
+ }
+ };
+}
+
+/**
+ Converts maps to dictionaries.
+ */
+export function jMap<A>(fn: Loose<A>): Safe<Map<string, A>> {
+ return (js: json) => {
+ const m = new Map<string, A>();
+ if (js !== null && typeof js === 'object' && !Array.isArray(js)) {
+ for (let k of Object.keys(js)) {
+ const v = fn(js[k]);
+ if (v !== undefined) m.set(k, v);
+ }
+ }
+ return m;
+ };
+}
+
+/**
+ Converts dictionaries to maps.
+ */
+export function eMap<A>(fn: Encoder<A>): Encoder<Map<string, undefined | A>> {
+ return m => {
+ const js: json = {};
+ m.forEach((v, k) => {
+ if (v !== undefined) {
+ const u = fn(v);
+ if (u !== undefined) js[k] = u;
+ }
+ });
+ return js;
+ };
+}
+
+/**
+ Apply the decoder on each item of a JSON array, or return `[]` otherwise.
+ Can be also applied on a _loose_ decoder, but you will get
+ an array with possibly `undefined` elements. Use [[jList]]
+ to discard undefined elements, or use a true _safe_ decoder.
+ */
+export function jArray<A>(fn: Safe<A>): Safe<A[]> {
+ return (js: json) => Array.isArray(js) ? js.map(fn) : [];
+}
+
+/**
+ Apply the loose decoder on each item of a JSON array, discarding
+ all `undefined` elements. To keep the all possibly undefined array entries,
+ use [[jArray]] instead.
+ */
+export function jList<A>(fn: Loose<A>): Safe<A[]> {
+ return (js: json) => {
+ const buffer: A[] = [];
+ if (Array.isArray(js)) js.forEach(vj => {
+ const d = fn(vj);
+ if (d !== undefined) buffer.push(d);
+ });
+ return buffer;
+ };
+}
+
+/**
+ Exports all non-undefined elements.
+ */
+export function eList<A>(fn: Encoder<A>): Encoder<(A | undefined)[]> {
+ return m => {
+ const js: json[] = [];
+ m.forEach(v => {
+ if (v !== undefined) {
+ const u = fn(v);
+ if (u !== undefined) js.push(u);
+ }
+ });
+ return js;
+ };
+}
+
+/** Apply a pair of decoders to JSON pairs, or return `undefined`. */
+export function jPair<A, B>(
+ fa: Safe<A>,
+ fb: Safe<B>,
+): Loose<[A, B]> {
+ return (js: json) => Array.isArray(js) ? [
+ fa(js[0]),
+ fb(js[1]),
+ ] : undefined;
+}
+
+/** Similar to [[jPair]]. */
+export function jTriple<A, B, C>(
+ fa: Safe<A>,
+ fb: Safe<B>,
+ fc: Safe<C>,
+): Loose<[A, B, C]> {
+ return (js: json) => Array.isArray(js) ? [
+ fa(js[0]),
+ fb(js[1]),
+ fc(js[2]),
+ ] : undefined;
+}
+
+/** Similar to [[jPair]]. */
+export function jTuple4<A, B, C, D>(
+ fa: Safe<A>,
+ fb: Safe<B>,
+ fc: Safe<C>,
+ fd: Safe<D>,
+): Loose<[A, B, C, D]> {
+ return (js: json) => Array.isArray(js) ? [
+ fa(js[0]),
+ fb(js[1]),
+ fc(js[2]),
+ fd(js[3]),
+ ] : undefined;
+}
+
+/** Similar to [[jPair]]. */
+export function jTuple5<A, B, C, D, E>(
+ fa: Safe<A>,
+ fb: Safe<B>,
+ fc: Safe<C>,
+ fd: Safe<D>,
+ fe: Safe<E>,
+): Loose<[A, B, C, D, E]> {
+ return (js: json) => Array.isArray(js) ? [
+ fa(js[0]),
+ fb(js[1]),
+ fc(js[2]),
+ fd(js[3]),
+ fe(js[4]),
+ ] : undefined;
+}
+
+/**
+ Decoders for each property of object type `A`.
+ Optional fields in `A` can be assigned a loose decoder.
+*/
+export type Props<A> = {
+ [P in keyof A]: Safe<A[P]>;
+}
+
+/**
+ Decode an object given the decoders of its fields.
+ Returns `undefined` for non-object JSON.
+ */
+export function jObject<A>(fp: Props<A>): Loose<A> {
+ return (js: json) => {
+ if (js !== null && typeof js === 'object' && !Array.isArray(js)) {
+ const buffer = {} as A;
+ for (var k of Object.keys(fp)) {
+ const fn = fp[k as keyof A];
+ if (fn !== undefined) {
+ const fj = js[k];
+ if (fj !== undefined) {
+ const fv = fn(fj);
+ if (fv !== undefined) buffer[k as keyof A] = fv;
+ }
+ }
+ }
+ return buffer;
+ }
+ return undefined;
+ };
+}
+
+/**
+ Returns the first decoder result that is not undefined.
+ */
+export function jUnion<A>(...cases: Loose<A>[]): Loose<A> {
+ return (js: json) => {
+ for (var fn of cases) {
+ const fv = fn(js);
+ if (fv !== undefined) return fv;
+ }
+ return undefined;
+ };
+}
+
+/**
+ Encoders for each property of object type `A`.
+*/
+export type EProps<A> = {
+ [P in keyof A]?: Encoder<A[P]>;
+}
+
+/**
+ Encode an object given the provided encoders by fields.
+ The exported JSON object has only original
+ fields with some specified encoder.
+ */
+export function eObject<A>(fp: EProps<A>): Encoder<A> {
+ return (m: A) => {
+ const js: json = {};
+ for (var k of Object.keys(fp)) {
+ const fn = fp[k as keyof A];
+ if (fn !== undefined) {
+ const fv = m[k as keyof A];
+ if (fv !== undefined) {
+ const r = fn(fv);
+ if (r !== undefined) js[k] = r;
+ }
+ }
+ }
+ return js;
+ }
+}
+
+// Intentionnaly internal and only declared
+declare const tag: unique symbol;
+
+/** Phantom type. */
+export type phantom<K, A> = A & { tag: K };
+
+export function forge<K, A>(_tag: K, data: A): phantom<K, A> {
+ return data as any;
+}
+
+/** String key with kind. Can be used as a `string` but shall be created with [forge]. */
+export type key<K> = phantom<K, string>;
+
+/** Number index with kind. Can be used as a `number` but shall be created with [forge]. */
+export type index<K> = phantom<K, number>;
+
+/** Decoder for `key<K>` strings. */
+export function jKey<K>(kd: K): Loose<key<K>> {
+ return (js: json) => typeof js === 'string' ? forge(kd, js) : undefined;
+}
+
+/** Decoder for `index<K>` numbers. */
+export function jIndex<K>(kd: K): Loose<index<K>> {
+ return (js: json) => typeof js === 'number' ? forge(kd, js) : undefined;
+}
+
+/** Dictionaries with « typed » keys. */
+export type dict<K, A> = phantom<K, { [key: string]: A }>
+
+/** Lookup into dictionary.
+ Better than a direct access to `d[k]` for undefined values. */
+export function lookup<K, A>(d: dict<K, A>, k: key<K>): A | undefined {
+ return d[k];
+}
+
+/** Empty dictionary. */
+export function empty<K, A>(kd: K): dict<K, A> {
+ return forge(kd, {} as any);
+}
+
+/** Dictionary extension. */
+export function index<K, A>(d: dict<K, A>, key: key<K>, value: A) {
+ d[key] = value;
+}
+
+/**
+ Decode a JSON dictionary, discarding all inconsistent entries.
+ If the JSON contains no valid entry, still returns `{}`.
+*/
+export function jDictionary<K, A>(kd: K, fn: Loose<A>): Safe<dict<K, A>> {
+ return (js: json) => {
+ const buffer: dict<K, A> = empty(kd);
+ if (js !== null && typeof js === 'object' && !Array.isArray(js)) {
+ for (var key of Object.keys(js)) {
+ const fd = js[key];
+ if (fd !== undefined) {
+ const fv = fn(fd);
+ if (fv !== undefined) index(buffer, forge(kd, key), fv);
+ }
+ }
+ }
+ return buffer;
+ };
+}
+
+/**
+ Encode a dictionary into JSON, discarding all inconsistent entries.
+ If the dictionary contains no valid entry, still returns `{}`.
+*/
+export function eDictionary<K, A>(fn: Encoder<A>): Encoder<dict<K, A>> {
+ return (d: dict<K, A>) => {
+ const js: json = {};
+ for (var k of Object.keys(d)) {
+ const fv = d[k];
+ if (fv !== undefined) {
+ const fr = fn(fv);
+ if (fr !== undefined) js[k] = fr;
+ }
+ }
+ return js;
+ };
+}
+
+// --------------------------------------------------------------------------
diff --git a/ivette/src/dome/src/renderer/data/states.ts b/ivette/src/dome/src/renderer/data/states.ts
new file mode 100644
index 0000000000000000000000000000000000000000..c1fbb827435c3b1f721268d059e9a4640d7aeb0b
--- /dev/null
+++ b/ivette/src/dome/src/renderer/data/states.ts
@@ -0,0 +1,280 @@
+// --------------------------------------------------------------------------
+// --- States
+// --------------------------------------------------------------------------
+
+/**
+ Typed States & Settings
+ @packageDocumentation
+ @module dome/data/states
+*/
+
+import React from 'react';
+import Emitter from 'events';
+import isEqual from 'react-fast-compare';
+import { DEVEL } from 'dome/misc/system';
+import * as Dome from 'dome';
+import * as JSON from './json';
+
+const UPDATE = 'dome.states.update';
+
+/** Cross-component State. */
+export class State<A> {
+
+ private value: A;
+ private emitter: Emitter;
+
+ constructor(initValue: A) {
+ this.value = initValue;
+ this.emitter = new Emitter;
+ this.getValue = this.getValue.bind(this);
+ this.setValue = this.setValue.bind(this);
+ }
+
+ /** Current state value. */
+ getValue() { return this.value; }
+
+ /** Notify callbacks on change, using _deep_ structural comparison. */
+ setValue(value: A) {
+ if (!isEqual(value, this.value)) {
+ this.value = value;
+ this.emitter.emit(UPDATE, value);
+ }
+ }
+
+ /** Callback Emitter. */
+ on(callback: (value: A) => void) {
+ this.emitter.on(UPDATE, callback);
+ }
+
+ /** Callback Emitter. */
+ off(callback: (value: A) => void) {
+ this.emitter.off(UPDATE, callback);
+ }
+
+}
+
+/** React Hook, similar to `React.useState()`. */
+export function useState<A>(s: State<A>): [A, (update: A) => void] {
+ const [current, setCurrent] = React.useState<A>(s.getValue);
+ React.useEffect(() => {
+ s.on(setCurrent);
+ return () => s.off(setCurrent);
+ });
+ return [current, s.setValue];
+};
+
+// --------------------------------------------------------------------------
+// --- Settings
+// --------------------------------------------------------------------------
+
+/**
+ Generic interface to Window and Global Settings.
+ To be used with [[useSettings]] with instances of its derived classes,
+ typically [[WindowSettings]] and [[GlobalSettings]]. You should never have
+ to implement a Settings class on your own.
+
+ All setting values are identified with
+ an untyped `dataKey: string`, that can be dynamically modified
+ for each component. Hence, two components might share both datakeys
+ and settings.
+
+ When several components share the same setting `dataKey` the behavior will be
+ different depending on the situation:
+ - for Window Settings, each component in each window retains its own
+ setting value, although the last modified value from _any_ of them will be
+ saved and used for any further initial value;
+ - for Global Settings, all components synchronize to the last modified value
+ from any component of any window.
+
+ Type safety is ensured by safe JSON encoders and decoders, however, they
+ might fail at runtime, causing settings value to be initialized to their
+ fallback and not to be saved nor synchronized.
+ This is not harmful but annoying.
+
+ To mitigate this effect, each instance of a Settings class has its
+ own, private, unique symbol that we call its « role ». A given `dataKey`
+ shall always be used with the same « role » otherwise it is discarded,
+ and an error message is logged when in DEVEL mode.
+ */
+export abstract class Settings<A> {
+
+ private static keyRoles = new Map<string, symbol>();
+
+ private readonly role: symbol;
+ protected readonly decoder: JSON.Safe<A>;
+ protected readonly encoder: JSON.Encoder<A>;
+
+ /**
+ Encoders shall be protected against exception.
+ Use [[dome/data/json.jTry]] and [[dome/data/json.jCatch]] in case of uncertainty.
+ Decoders are automatically protected internally to the Settings class.
+ @param role Debugging name of instance roles (each instance has its unique
+ role, though)
+ @param decoder JSON decoder for the setting values
+ @param encoder JSON encoder for the setting values
+ @param fallback If provided, used to automatically protect your encoders
+ against exceptions.
+ */
+ constructor(
+ role: string,
+ decoder: JSON.Safe<A>,
+ encoder: JSON.Encoder<A>,
+ fallback?: A,
+ ) {
+ this.role = Symbol(role);
+ this.encoder = encoder;
+ this.decoder =
+ fallback !== undefined ? JSON.jCatch(decoder, fallback) : decoder;
+ }
+
+ /**
+ Returns identity if the data key is only
+ used with the same setting instance.
+ Otherwise, returns `undefined`.
+ */
+ validateKey(dataKey?: string): string | undefined {
+ if (dataKey === undefined) return undefined;
+ const rq = this.role;
+ const rk = Settings.keyRoles.get(dataKey);
+ if (rk === undefined) {
+ Settings.keyRoles.set(dataKey, rq);
+ } else {
+ if (rk !== rq) {
+ if (DEVEL) console.error(
+ `[Dome.settings] Key ${dataKey} used with incompatible roles`, rk, rq,
+ );
+ return undefined;
+ }
+ }
+ return dataKey;
+ }
+
+ /** @internal */
+ abstract loadData(key: string): JSON.json;
+
+ /** @internal */
+ abstract saveData(key: string, data: JSON.json): void;
+
+ /** @internal */
+ abstract event: string;
+
+ /** Returns the current setting value for the provided data key. You shall
+ only use validated keys otherwise you might fallback to default values. */
+ loadValue(dataKey?: string) {
+ return this.decoder(dataKey ? this.loadData(dataKey) : undefined)
+ }
+
+ /** Push the new setting value for the provided data key.
+ You shall only use validated keys otherwise further loads
+ might fail and fallback to defaults. */
+ saveValue(dataKey: string, value: A) {
+ try { this.saveData(dataKey, this.encoder(value)); }
+ catch (err) {
+ if (DEVEL) console.error(
+ '[Dome.settings] Error while encoding value',
+ dataKey, value, err,
+ );
+ }
+ }
+
+}
+
+/**
+ Generic React Hook to be used with any kind of [[Settings]].
+ You may share `dataKey` between components, or change it dynamically.
+ However, a given data key shall always be used for the same Setting instance.
+ See [[Settings]] documentation for details.
+ @param S The instance settings to be used.
+ @param dataKey Identifies which value in the settings to be used.
+ */
+export function useSettings<A>(
+ S: Settings<A>,
+ dataKey?: string,
+): [A, (update: A) => void] {
+
+ const theKey = React.useMemo(() => S.validateKey(dataKey), [S, dataKey]);
+ const [value, setValue] = React.useState<A>(() => S.loadValue(theKey));
+
+ React.useEffect(() => {
+ if (theKey) {
+ const callback = () => setValue(S.loadValue(theKey));
+ Dome.on(S.event, callback);
+ return () => Dome.off(S.event, callback);
+ }
+ return undefined;
+ });
+
+ const updateValue = React.useCallback((update: A) => {
+ if (!isEqual(value, update)) {
+ setValue(update);
+ if (theKey) S.saveValue(theKey, update);
+ }
+ }, [S, theKey]);
+
+ return [value, updateValue];
+
+}
+
+/** Window Settings for non-JSON data.
+ In most situations, you can use [[WindowSettings]] instead.
+ You can use a [[dome/data/json.Loose]] decoder for optional values. */
+export class WindowSettingsData<A> extends Settings<A> {
+
+ constructor(
+ role: string,
+ decoder: JSON.Safe<A>,
+ encoder: JSON.Encoder<A>,
+ fallback?: A,
+ ) {
+ super(role, decoder, encoder, fallback);
+ }
+
+ event = 'dome.defaults';
+ loadData(key: string) { return Dome.getWindowSetting(key) as JSON.json; }
+ saveData(key: string, data: JSON.json) { Dome.setWindowSetting(key, data); }
+
+}
+
+/** Global Settings for non-JSON data.
+ In most situations, you can use [[WindowSettings]] instead.
+ You can use a [[dome/data/json.Loose]] decoder for optional values. */
+export class GlobalSettingsData<A> extends Settings<A> {
+
+ constructor(
+ role: string,
+ decoder: JSON.Safe<A>,
+ encoder: JSON.Encoder<A>,
+ fallback?: A,
+ ) {
+ super(role, decoder, encoder, fallback);
+ }
+
+ event = 'dome.settings';
+ loadData(key: string) { return Dome.getGlobalSetting(key) as JSON.json; }
+ saveData(key: string, data: JSON.json) { Dome.setGlobalSetting(key, data); }
+
+}
+
+/** Window Settings.
+ For non-JSON data, use [[WindowSettingsData]] instead.
+ You can use a [[dome/data/json.Loose]] decoder for optional values. */
+export class WindowSettings<A extends JSON.json> extends WindowSettingsData<A> {
+
+ constructor(role: string, decoder: JSON.Safe<A>, fallback?: A) {
+ super(role, decoder, JSON.identity, fallback);
+ }
+
+}
+
+/** Global Settings.
+ For non-JSON data, use [[WindowSettingsData]] instead.
+ You can use a [[dome/data/json.Loose]] decoder for optional values. */
+export class GlobalSettings<A extends JSON.json> extends GlobalSettingsData<A> {
+
+ constructor(role: string, decoder: JSON.Safe<A>, fallback?: A) {
+ super(role, decoder, JSON.identity, fallback);
+ }
+
+}
+
+// --------------------------------------------------------------------------
diff --git a/ivette/src/dome/src/renderer/dome.js b/ivette/src/dome/src/renderer/dome.js
index 55f1a81cadb1de48ba7d2d72b9ded74d41ba827b..322a76d8bc3242c7d2631da72db37257d2602649 100644
--- a/ivette/src/dome/src/renderer/dome.js
+++ b/ivette/src/dome/src/renderer/dome.js
@@ -148,10 +148,6 @@ ipcRenderer.on('dome.ipc.command', (_event,argv,wdir) => {
emitter.emit('dome.command',argv,wdir);
});
-// --------------------------------------------------------------------------
-// --- Main-Process Communication
-// --------------------------------------------------------------------------
-
// --------------------------------------------------------------------------
// --- Window Management
// --------------------------------------------------------------------------
@@ -395,55 +391,69 @@ export function popupMenu( items, callback )
// --- Settings
// --------------------------------------------------------------------------
-var globals = {} ;
-var globalPatches = {} ;
+var globalSettings = new Map();
+var globalPatches = new Map();
-var settings = {} ;
-var settingsPatches = {} ;
+var windowSettings = new Map();
+var windowPatches = new Map();
+
+const initSetting =
+ (m, data) => _.forEach(data,(value,key) => m.set(key,value));
// initial values => synchronized event
-function syncSettings() {
+const syncSettings = () => {
const fullSettings = ipcRenderer.sendSync('dome.ipc.settings.sync');
- globals = fullSettings.globals ;
- settings = fullSettings.settings ;
-}
+ initSetting( globalSettings, fullSettings.globals );
+ initSetting( windowSettings, fullSettings.settings );
+};
const readSetting = ( local, key, defaultValue ) => {
- const value = _.get( local ? settings : globals , key );
+ const store = local ? windowSettings : globalSettings;
+ const value = store.get(key);
return value === undefined ? defaultValue : value ;
};
const writeSetting = ( local, key, value ) => {
- if (key) {
- const theValue = value===undefined ? null : value ;
- const store = local ? settings : globals ;
- const patches = local ? settingsPatches : globalPatches ;
- _.set( store, key, theValue );
- _.set( patches, key, theValue );
+ const store = local ? windowSettings : globalSettings;
+ const patches = local ? windowPatches : globalPatches;
+ if (value === undefined) {
+ store.delete(key);
+ patches.set(key,null);
+ } else {
+ store.set(key,value);
+ patches.set(key,value);
+ }
+ if (local) {
+ fireSaveSettings();
+ } else {
emitter.emit('dome.settings');
- if (local) {
- if (DEVEL) fireSaveSettings();
- } else {
- fireSaveGlobals();
- }
+ fireSaveGlobals();
+ }
+};
+
+const flushPatches = (m) => {
+ if (m.size > 0) {
+ const args = [];
+ m.forEach((value,key) => {
+ args.push({ key, value });
+ });
+ m.clear();
+ return args;
}
+ return undefined;
};
const fireSaveSettings = _.debounce(
() => {
- if (!_.isEmpty(settingsPatches)) {
- ipcRenderer.send( 'dome.ipc.settings.window', settingsPatches ) ;
- settingsPatches = {} ;
- }
+ const args = flushPatches(windowPatches);
+ args && ipcRenderer.send( 'dome.ipc.settings.window', args ) ;
}, 100
);
const fireSaveGlobals = _.debounce(
() => {
- if (!_.isEmpty(globalPatches)) {
- ipcRenderer.send( 'dome.ipc.settings.global', globalPatches ) ;
- globalPatches = {} ;
- }
+ const args = flushPatches(globalPatches);
+ args && ipcRenderer.send( 'dome.ipc.settings.global', args ) ;
}, 100
);
@@ -456,25 +466,32 @@ ipcRenderer.on('dome.ipc.closing', (_evt) => {
});
/** @event 'dome.settings'
- @description Emitted when the settings have been updated. */
+ @description Emitted when the global settings have been updated. */
/** @event 'dome.defaults'
- @description Emitted when the settings have been reset to default. */
+ @description Emitted when the window settings have re-initialized. */
ipcRenderer.on('dome.ipc.settings.defaults',(sender) => {
fireSaveSettings.cancel();
fireSaveGlobals.cancel();
- settingsPatches = {};
- globalPatches = {};
- settings = {};
- globals = {};
- emitter.emit('dome.defaults');
+ windowPatches.clear();
+ globalPatches.clear();
+ windowSettings.clear();
+ globalSettings.clear();
emitter.emit('dome.settings');
+ emitter.emit('dome.defaults');
});
ipcRenderer.on('dome.ipc.settings.update',(sender,patches) => {
- // Don't cancel local updates
- _.merge( globals , patches , globalPatches );
+ patches.forEach(({ key, value }) => {
+ // Don't cancel local updates
+ if (!globalPatches.has(key)) {
+ if (value === null)
+ globalSettings.delete(key);
+ else
+ globalSettings.set(key,value);
+ }
+ });
emitter.emit('dome.settings');
});
@@ -493,7 +510,7 @@ export function getWindowSetting( key, defaultValue ) {
}
/** @summary Set value into local window (persistent) settings.
- @param {string} key to store the data
+ @param {string} [key] to store the data
@param {any} value associated value or object
@description
This settings are local to the current window, but persistently
@@ -501,7 +518,7 @@ export function getWindowSetting( key, defaultValue ) {
For global application settings, use `setGlobal()` instead.
*/
export function setWindowSetting( key , value ) {
- writeSetting( true, key, value );
+ key && writeSetting( true, key, value );
}
/**
@@ -524,7 +541,8 @@ export function getGlobalSetting( key, defaultValue ) {
@description
These settings are global to the current window, but persistently
saved in the user's home directory. Updated values are broadcasted
- in batch to all other windows, which in turn receive a `'dome.settings'`
+ in batch to all other windows,
+ which in turn receive a `'dome.settings'`
event for synchronizing.<br/>
For local window settings, use `set()` instead.
*/
@@ -684,25 +702,21 @@ export function useCommand() {
function useSettings( local, settings, defaultValue )
{
- const [ value, setValue ] = React.useState(() => readSetting( local, settings, defaultValue ));
+ const [ value, setValue ] =
+ React.useState(() => readSetting( local, settings, defaultValue ));
React.useEffect(() => {
- if (settings) {
- let callback = () => {
- let v = readSetting( local, settings , defaultValue );
- setValue(v);
- };
- emitter.on('dome.settings',callback);
- return () => emitter.off( 'dome.settings', callback );
- } else {
- let callback = () => setValue(defaultValue);
- emitter.on('dome.defaults',callback);
- return () => emitter.off( 'dome.defaults', callback );
- }
+ let callback = () => {
+ let v = readSetting( local, settings , defaultValue );
+ setValue(v);
+ };
+ const event = local ? 'dome.defaults' : 'dome.settings' ;
+ emitter.on(event,callback);
+ return () => emitter.off(event, callback);
});
const doUpdate = (upd) => {
const theValue = typeof(upd)==='function' ? upd(value) : upd ;
if (settings) writeSetting( local, settings, theValue );
- else setValue(theValue);
+ if (local) setValue(theValue);
};
return [ value, doUpdate ];
}
@@ -715,8 +729,7 @@ function useSettings( local, settings, defaultValue )
@description
Similar to `React.useState()` with persistent _window_ settings.
When the settings key is undefined, it simply uses a local React state.
- Also responds to `'dome.settings'` to update the state and `'dome.defaults'`
- to restore the default value.
+ Also responds to `'dome.defaults'`.
The `setValue` callback accepts either a value, or a function to be applied
on current value.
@@ -750,8 +763,7 @@ export function useSwitch( settings, defaultValue=false )
@description
Similar to `React.useState()` with persistent _global_ settings.
When the settings key is undefined, it simply uses a local React state.
- Also responds to `'dome.settings'` to update the state and `'dome.defaults'`
- to restore the default value.
+ Also responds to `'dome.settings'` to update the state.
The `setValue` callback accepts either a value, or a function to be applied
on current value.
diff --git a/ivette/src/dome/src/renderer/frame/sidebars.js b/ivette/src/dome/src/renderer/frame/sidebars.js
index 08ed6ae624eea139d9d54fac1198d05a1c90a685..6fcd8e42a50b7fca2f0dff2261ebd09b4daf413b 100644
--- a/ivette/src/dome/src/renderer/frame/sidebars.js
+++ b/ivette/src/dome/src/renderer/frame/sidebars.js
@@ -108,7 +108,7 @@ export function Section(props) {
const context = React.useContext( SideBarContext );
const [ state=true, setState ] = Dome.useState(
- makeSettings(context,props),
+ makeSettings(context.settings,props),
props.defaultUnfold
);
const { enabled=true, disabled=false, unfold, children } = props ;
diff --git a/ivette/src/dome/src/renderer/table/arrays.ts b/ivette/src/dome/src/renderer/table/arrays.ts
index a0bdcca0db57fa54bda71e7b9dc543a176f12c6f..cfa453a1c8bfcceb52e347ff91c9fd738a6d85ab 100644
--- a/ivette/src/dome/src/renderer/table/arrays.ts
+++ b/ivette/src/dome/src/renderer/table/arrays.ts
@@ -56,13 +56,12 @@ function orderByRing<K, R>(
// --------------------------------------------------------------------------
type INDEX<K, R> = Map<K, PACK<K, R>>;
-type TABLE<K, R> = PACK<K, R>[];
// --------------------------------------------------------------------------
// --- Array Model
// --------------------------------------------------------------------------
-export class MapModel<Key, Row>
+export class ArrayModel<Key, Row>
extends Model<Key, Row>
implements Sorting, Filtering<Key, Row>
{
@@ -70,8 +69,11 @@ export class MapModel<Key, Row>
// Hold raw data (unsorted, unfiltered)
private index: INDEX<Key, Row> = new Map();
- // Hold filtered & sorted data (computed on demand)
- private table?: TABLE<Key, Row>;
+ // Hold filtered & sorted data (computed and cached on demand)
+ private table?: PACK<Key, Row>[];
+
+ // Hold filtered & sorted array of data (computed and cached on demand)
+ private array?: Row[];
// Filtered-out Row Count
private filtered: number = 0;
@@ -105,11 +107,11 @@ export class MapModel<Key, Row>
}
// Lazily compute table
- protected rebuild(): TABLE<Key, Row> {
+ protected rebuild(): PACK<Key, Row>[] {
const current = this.table;
let filtered = 0;
if (current !== undefined) return current;
- let table: TABLE<Key, Row> = [];
+ let table: PACK<Key, Row>[] = [];
try {
this.index.forEach((packed) => {
packed.index = undefined;
@@ -164,7 +166,7 @@ export class MapModel<Key, Row>
comparison for un-specified columns are kept unchanged, if any.
This will be used to refine
[[setNaturalOrder]] in response to user column selection with
- [[setSortBy]] provided you enable by-column sorting from the table view.
+ [[setSorting]] provided you enable by-column sorting from the table view.
Finally triggers a reload. */
setColumnOrder(columns?: ByColumns<Row>) {
this.columns = { ...this.columns, ...columns };
@@ -174,7 +176,7 @@ export class MapModel<Key, Row>
/** Sets natural ordering of the rows.
It defines in which order the entries are rendered in the table. This
primary ordering can be refined in response to user column selection with
- [[setSortBy]] provided you enable by-column sorting from the table view.
+ [[setSorting]] provided you enable by-column sorting from the table view.
Finally triggers a reload. */
setNaturalOrder(order?: Order<Row>) {
this.natural = order;
@@ -184,7 +186,7 @@ export class MapModel<Key, Row>
/**
Sets both natural ordering and column ordering with the provided
orders by fields. This is a combination of [[setColumnOrder]] and
- [[setNaturalOrder]] with [[Compare.byFields]].
+ [[setNaturalOrder]] with [[dome/data/compare.byFields]].
*/
setOrderingByFields(byfields: ByFields<Row>) {
this.natural = Compare.byFields(byfields);
@@ -268,11 +270,10 @@ export class MapModel<Key, Row>
/** Trigger a complete reload of the table. */
reload() {
- if (this.table || this.order) {
- this.table = undefined;
- this.order = undefined;
- super.reload();
- }
+ this.array = undefined;
+ this.table = undefined;
+ this.order = undefined;
+ super.reload();
}
/** Remove all data and reload. */
@@ -382,13 +383,13 @@ export class MapModel<Key, Row>
}
/**
- Silently removes the entry.
+ Silently removes the entries.
Modification will be only visible after a final [[reload]].
Useful for a large number of batched updates.
@param key - the removed entry.
*/
- removeData(key: Key) {
- this.index.delete(key);
+ removeData(keys: Collection<Key>) {
+ forEach(keys, (k) => this.index.delete(k));
}
/**
@@ -411,6 +412,16 @@ export class MapModel<Key, Row>
return this.index.get(key)?.row;
}
+ /** Returns an array of filtered and sorted entries.
+ Computed on demand and cached. */
+ getArray(): Row[] {
+ let arr = this.array;
+ if (arr === undefined) {
+ arr = this.array = this.rebuild().map((e) => e.row);
+ }
+ return arr;
+ }
+
}
// --------------------------------------------------------------------------
@@ -418,45 +429,32 @@ export class MapModel<Key, Row>
// --------------------------------------------------------------------------
/**
- @template Row - object data that also contains « key »
+ @template Row - object data that also contains their « key »
*/
-export class ArrayModel<Row> extends MapModel<string, Row> {
+export class CompactModel<Key, Row> extends ArrayModel<Key, Row> {
- private key: keyof Row
+ getkey: (d: Row) => Key;
/** @param key - the key property of `Row` holding an entry identifier. */
- constructor(key: keyof Row) {
+ constructor(getkey: any) {
super();
- this.key = key;
+ this.getkey = getkey;
}
- /** Optimized, see [[getKey]]. */
- getKeyFor(_: number, data: Row) { return this.getKey(data); }
-
- /** Returns the key of data. */
- getKey(data: Row): string { return (data as any)[this.key]; }
+ /** Use the key getter directly. */
+ getKeyFor(_: number, data: Row) { return this.getkey(data); }
- /** Adds a collection of data. Finally triggers a reload. */
- add(data: Collection<Row>) {
- forEach(data, (row: Row) => this.setData(this.getKey(row), row));
+ /** Silently add or update a collection of data.
+ Requires a final trigger to update views. */
+ updateData(data: Collection<Row>) {
+ forEach(data, (row: Row) => this.setData(this.getkey(row), row));
this.reload();
}
- /** Replaces all previous entries with new ones. Finally triggers a reload. */
- replace(data: Collection<Row>) {
- this.removeAllData();
- this.add(data);
- }
-
- /** Removes a colllection of data, identified by keys or (key of) rows.
- Finally triggers a reload. */
- remove(data: Collection<string | Row>) {
- forEach(data, e => {
- const k = typeof e === 'string' ? e : this.getKey(e);
- this.removeData(k);
- });
- this.reload();
- }
+ /**
+ Replace all previous data with the new one.
+ Finally triggers a reload.
+ */
}
diff --git a/ivette/src/dome/src/renderer/table/models.ts b/ivette/src/dome/src/renderer/table/models.ts
index c6f38e21a31348ee17133fec06bd39204376a204..c34b260857850e4f456dceff0c0ff562813a8a28 100644
--- a/ivette/src/dome/src/renderer/table/models.ts
+++ b/ivette/src/dome/src/renderer/table/models.ts
@@ -7,6 +7,7 @@
@module dome/table/models
*/
+import React from 'react';
import { SortDirectionType } from 'react-virtualized';
// --------------------------------------------------------------------------
@@ -195,22 +196,26 @@ export abstract class Model<Key, Row> {
Re-render all views.
Bound to this.
*/
- reload() { this.clients.forEach(({ reload }) => reload && reload()); }
+ reload() {
+ this.clients.forEach(({ reload }) => reload && reload());
+ }
/**
Connect a client view to the model.
The initial watching range is empty with no trigger.
You normally never call this method directly.
It is automatically called by table views.
+ @param onReload - optional callback for reloads (and updates, unless specified)
+ @param onUpdate - optional callback for updates (when different from reloads)
*/
- link(): Client {
+ link(onReload?: Trigger, onUpdate?: Trigger): Client {
const id = this.clientsId++;
const m = this.clients;
const w: Watcher & Client = {
lower: 0,
upper: 0,
- update: undefined,
- reload: undefined,
+ reload: onReload,
+ update: onUpdate ?? onReload,
onUpdate(s?: Trigger) { w.update = s; },
onReload(s?: Trigger) { w.reload = s; },
unlink() { m.delete(id); },
@@ -226,3 +231,21 @@ export abstract class Model<Key, Row> {
}
// --------------------------------------------------------------------------
+// --- Model Hooks
+// --------------------------------------------------------------------------
+
+/**
+ For a component to re-render on any updates and reloads.
+ The returned number can be used to memoise effects and callbacks.
+ */
+
+export function useModel(model: Model<any, any>): number {
+ const [age, setAge] = React.useState(0);
+ React.useEffect(() => {
+ const w = model.link(() => setImmediate(() => setAge(age + 1)));
+ return w.unlink;
+ });
+ return age;
+}
+
+// --------------------------------------------------------------------------
diff --git a/ivette/src/dome/src/renderer/table/views.tsx b/ivette/src/dome/src/renderer/table/views.tsx
index 953cdbdf5901e39f3b9ae3eff6de5a7affa1f1b8..5e7888b7c89035af4b1b8de6cfa738f47a075fdd 100644
--- a/ivette/src/dome/src/renderer/table/views.tsx
+++ b/ivette/src/dome/src/renderer/table/views.tsx
@@ -8,7 +8,7 @@
*/
import React, { ReactNode } from 'react';
-import { forEach, debounce } from 'lodash';
+import { forEach, debounce, throttle } from 'lodash';
import isEqual from 'react-fast-compare';
import * as Dome from 'dome';
import { DraggableCore } from 'react-draggable';
@@ -212,7 +212,7 @@ function makeDataGetter(
if (rowData !== undefined) return getter(rowData, dataKey);
} catch (err) {
console.error(
- '[Dome.table] custom getter error',
+ '[Dome.table] Custom getter error',
'rowData:', rowData,
'dataKey:', dataKey,
err,
@@ -240,7 +240,7 @@ function makeDataRenderer(
return contents;
} catch (err) {
console.error(
- '[Dome.table] custom renderer error',
+ '[Dome.table] Custom renderer error',
'dataKey:', props.dataKey,
'cellData:', cellData,
err,
@@ -295,9 +295,9 @@ class TableState<Key, Row> {
constructor() {
this.unwind = this.unwind.bind(this);
- this.forceUpdate = this.forceUpdate.bind(this);
+ this.forceUpdate = throttle(this.forceUpdate.bind(this), 200);
+ this.updateGrid = throttle(this.updateGrid.bind(this), 200);
this.fullReload = this.fullReload.bind(this);
- this.updateGrid = this.updateGrid.bind(this);
this.onRowsRendered = this.onRowsRendered.bind(this);
this.rowClassName = this.rowClassName.bind(this);
this.onHeaderMenu = this.onHeaderMenu.bind(this);
diff --git a/ivette/src/dome/src/renderer/text/buffers.js b/ivette/src/dome/src/renderer/text/buffers.js
index 2546e8f5b7cc81d1a159c4a2d218c811fc028625..b25bf354c55eb01028dd728e69b8af29b4a27459 100644
--- a/ivette/src/dome/src/renderer/text/buffers.js
+++ b/ivette/src/dome/src/renderer/text/buffers.js
@@ -546,11 +546,11 @@ is blocked.
/**
@summary Print text containing tags into buffer (bound to `this`).
- @param {string|string[]} text - Text to print.
+ @param {any} text - Text to print.
@param {object} options - CodeMirror
[text marker](https://codemirror.net/doc/manual.html#api_marker) options.
*/
- printTextWithTags(text = '', options = {}) {
+ printTextWithTags(text, options = {}) {
if (Array.isArray(text)) {
const tag = text.shift();
if (tag !== '') {
@@ -563,7 +563,7 @@ is blocked.
}
} else if (typeof text === 'string') {
this.append(text);
- } else if (text !== null) {
+ } else if (text !== null && text !== undefined) {
console.error('[Dome.buffers] unexpected text',text);
}
}
diff --git a/ivette/src/dome/template/makefile.packages b/ivette/src/dome/template/makefile.packages
index 05b8cb03aece9be54813a53d3952d9e804943839..34a494d77320ff171a14873d6eb15b4456e9bbc0 100644
--- a/ivette/src/dome/template/makefile.packages
+++ b/ivette/src/dome/template/makefile.packages
@@ -25,6 +25,7 @@ DOME_APP_PACKAGES= \
lodash \
react-virtualized \
react-draggable \
+ react-fast-compare \
codemirror
# --------------------------------------------------------------------------
diff --git a/ivette/src/frama-c/LabViews.tsx b/ivette/src/frama-c/LabViews.tsx
index d41a4bc67b37746d9f5fe3c1b9b0e1a0a9928a24..52bc3151cac0951f6f9642dee1e7ceb83b05dc6b 100644
--- a/ivette/src/frama-c/LabViews.tsx
+++ b/ivette/src/frama-c/LabViews.tsx
@@ -355,7 +355,6 @@ function CustomViews({ settings, shape, setShape, views: libViews }: any) {
const [edited, setEdited]: any = React.useState();
const triggerDefault = React.useRef();
const { current, shapes = {} } = local;
-
const theViews: any = {};
_.forEach(libViews, (view) => {
diff --git a/ivette/src/frama-c/server.ts b/ivette/src/frama-c/server.ts
index 20c49679aa4aacd25faf3f337c5c49d3f91ef1a5..d400a9745fe2cb5429a904414641a6def97d3a0e 100644
--- a/ivette/src/frama-c/server.ts
+++ b/ivette/src/frama-c/server.ts
@@ -12,6 +12,7 @@ import _ from 'lodash';
import React from 'react';
import * as Dome from 'dome';
import * as System from 'dome/system';
+import * as Json from 'dome/data/json';
import { RichTextBuffer } from 'dome/text/buffers';
import { Request as ZmqRequest } from 'zeromq';
import { ChildProcess } from 'child_process';
@@ -123,7 +124,8 @@ let rqCount = 0;
type IndexedPair<T, U> = {
[index: string]: [T, U];
};
-type ResolvePromise = (value?: any) => void;
+
+type ResolvePromise = (value: Json.json) => void;
type RejectPromise = (error: Error) => void;
/** Pending promise callbacks (pairs of (resolve, reject)). */
@@ -583,7 +585,7 @@ function _exit(error?: Error) {
// --- Signal Management
// --------------------------------------------------------------------------
-class Signal {
+class SignalHandler {
id: any;
event: string;
active: boolean;
@@ -646,12 +648,12 @@ class Signal {
// --- Memo
-const signals: Map<string, Signal> = new Map();
+const signals: Map<string, SignalHandler> = new Map();
function _signal(id: any) {
let s = signals.get(id);
if (!s) {
- s = new Signal(id);
+ s = new SignalHandler(id);
signals.set(id, s);
}
return s;
@@ -667,8 +669,8 @@ function _signal(id: any) {
* @param {string} id The signal identifier to listen to.
* @param {function} callback The callback to call upon signal.
*/
-export function onSignal(id: string, callback: any) {
- _signal(id).on(callback);
+export function onSignal(s: Signal, callback: any) {
+ _signal(s.name).on(callback);
}
/**
@@ -679,8 +681,8 @@ export function onSignal(id: string, callback: any) {
* @param {string} id The signal identifier that was listen to.
* @param {function} callback The callback to remove.
*/
-export function offSignal(id: string, callback: any) {
- _signal(id).off(callback);
+export function offSignal(s: Signal, callback: any) {
+ _signal(s.name).off(callback);
}
/**
@@ -688,25 +690,25 @@ export function offSignal(id: string, callback: any) {
* @param {string} id The signal identifier to listen to.
* @param {function} callback The callback to call upon signal.
*/
-export function useSignal(id: string, callback: any) {
+export function useSignal(s: Signal, callback: any) {
React.useEffect(() => {
- onSignal(id, callback);
- return () => { offSignal(id, callback); };
+ onSignal(s, callback);
+ return () => { offSignal(s, callback); };
});
}
// --- Server Synchro
Dome.on(READY, () => {
- signals.forEach((signal: Signal) => {
- signal.sigon();
+ signals.forEach((h: SignalHandler) => {
+ h.sigon();
});
});
Dome.on(SHUTDOWN, () => {
- signals.forEach((signal: Signal) => {
- signal.unplug();
- (signal.sigoff as unknown as _.Cancelable).cancel();
+ signals.forEach((h: SignalHandler) => {
+ h.unplug();
+ (h.sigoff as unknown as _.Cancelable).cancel();
});
});
@@ -715,45 +717,37 @@ Dome.on(SHUTDOWN, () => {
// --------------------------------------------------------------------------
/** Request kind. */
-enum RqKind {
+export enum RqKind {
/** Used to read data from the Frama-C server. */
- R_GET = 'GET',
+ GET = 'GET',
/** Used to write data into the Frama-C server. */
- R_SET = 'SET',
+ SET = 'SET',
/** Used to make the Frama-C server execute a task. */
- R_EXEC = 'EXEC'
+ EXEC = 'EXEC'
}
/** Server request. */
-export interface Request {
- /** The request identifier on the Frama-C server. */
- endpoint: string;
- /** The request parameters. */
- params: any;
+export interface Request<Kd extends RqKind, In, Out> {
+ kind: Kd;
+ /** The request full name. */
+ name: string;
+ /** Encoder of input parameters. */
+ input: Json.Loose<In>;
+ /** Decoder of output parameters. */
+ output: Json.Loose<Out>;
}
-/**
- * Read data from the Frama-C server.
- * @param {Request} sr
- */
-export async function GET(sr: Request) {
- return send(RqKind.R_GET, sr);
+/** Server signal. */
+export interface Signal {
+ name: string;
}
-/**
- * Write data into the Frama-C server.
- * @param {Request} sr
- */
-export async function SET(sr: Request) {
- return send(RqKind.R_SET, sr);
-}
+export type GetRequest<In, Out> = Request<RqKind.GET, In, Out>;
+export type SetRequest<In, Out> = Request<RqKind.SET, In, Out>;
+export type ExecRequest<In, Out> = Request<RqKind.EXEC, In, Out>;
-/**
- * Make the Frama-C server execute a task.
- * @param {Request} sr
- */
-export async function EXEC(sr: Request) {
- return send(RqKind.R_EXEC, sr);
+export interface Killable<Data> extends Promise<Data> {
+ kill?: () => void;
}
/**
@@ -762,14 +756,21 @@ export async function EXEC(sr: Request) {
* You may _kill_ the request before its normal termination by
* invoking `kill()` on the returned promised.
*/
-function send(kind: RqKind, request: Request) {
+export function send<In, Out>(
+ request: Request<RqKind, In, Out>,
+ param: In,
+): Killable<Out> {
if (!isRunning()) return Promise.reject(new Error('Server not running'));
- if (!request.endpoint) return Promise.reject(new Error('Undefined request'));
+ if (!request.name) return Promise.reject(new Error('Undefined request'));
const rid = `RQ.${rqCount}`;
rqCount += 1;
- const data = JSON.stringify(request.params);
- const promise: any = new Promise((resolve, reject) => {
- pending[rid] = [resolve, reject];
+ const data = JSON.stringify(param);
+ const promise: Killable<Out> = new Promise<Out>((resolve, reject) => {
+ const decodedResolve = (js: Json.json) => {
+ const result = Json.jTry(request.output)(js);
+ resolve(result);
+ };
+ pending[rid] = [decodedResolve, reject];
});
promise.kill = () => {
if (zmqSocket && pending[rid]) {
@@ -777,7 +778,7 @@ function send(kind: RqKind, request: Request) {
_flush();
}
};
- queueCmd.push(kind, rid, request.endpoint, data);
+ queueCmd.push(request.kind, rid, request.name, data);
queueId.push(rid);
_flush();
return promise;
diff --git a/ivette/src/frama-c/states.ts b/ivette/src/frama-c/states.ts
index 258bd2c6f6842edcf6b22728495133ac7c566d13..97672cebe5d37308a1d773b4773a52ef87f825f6 100644
--- a/ivette/src/frama-c/states.ts
+++ b/ivette/src/frama-c/states.ts
@@ -9,29 +9,17 @@
Manage the current Frama-C project and projectified state values.
*/
-import _ from 'lodash';
import React from 'react';
import * as Dome from 'dome';
+import * as Json from 'dome/data/json';
+import { Order } from 'dome/data/compare';
+import * as GlobalStates from 'dome/data/states';
+import { useModel } from 'dome/table/models';
+import { CompactModel } from 'dome/table/arrays';
import * as Server from './server';
-/**
- * @event
- * @name 'frama-c.project'
- * @summary Current Project Updates
- * @description
- * Exported as `State.PROJECT` in public API.
- */
-export const PROJECT = 'frama-c.project';
-
-/**
- * @event
- * @name 'frama-c.state.*'
- * @summary State Notification Events.
- * @description
- * Event `'frama-c.state.<id>'` for project `<id>`.
- * The prefix `'frama-c.state.'` is exported as `States.STATE` in public API.
- */
-export const STATE = 'frama-c.state.';
+const PROJECT = 'frama-c.project';
+const STATE_PREFIX = 'frama-c.state.';
// --------------------------------------------------------------------------
// --- Pretty Printing (Browser Console)
@@ -44,16 +32,16 @@ const PP = new Dome.PP('States');
// --------------------------------------------------------------------------
let currentProject: string | undefined;
-let states: any = {};
-const stateDefaults: any = {};
Server.onReady(async () => {
try {
- const sr: Server.Request = {
- endpoint: 'kernel.project.getCurrent',
- params: {},
+ const sr: Server.GetRequest<null, { id?: string }> = {
+ kind: Server.RqKind.GET,
+ name: 'kernel.project.getCurrent',
+ input: Json.jNull,
+ output: Json.jObject({ id: Json.jString }),
};
- const current: { id: string } = await Server.GET(sr);
+ const current: { id?: string } = await Server.send(sr, null);
currentProject = current.id;
Dome.emit(PROJECT);
} catch (error) {
@@ -63,7 +51,6 @@ Server.onReady(async () => {
Server.onShutdown(() => {
currentProject = '';
- states = {};
Dome.emit(PROJECT);
});
@@ -72,8 +59,7 @@ Server.onShutdown(() => {
// --------------------------------------------------------------------------
/**
- * @summary Current Project (Custom React Hook).
- * @return {string} the current project identifier, or `undefined`.
+ Current Project (Custom React Hook).
*/
export function useProject() {
Dome.useUpdate(PROJECT);
@@ -81,17 +67,21 @@ export function useProject() {
}
/**
- * @summary Update Current Project.
- * @param {string} project - the project identifier
- * @description
- * Make all states switching to their projectified value.
- * Emits `PROJECT`.
+ Update Current Project.
+ Make all states switching to their projectified value.
+ Emits `PROJECT`.
+ @param project - the project identifier
*/
export async function setProject(project: string) {
if (Server.isRunning()) {
try {
- const sr = { endpoint: 'kernel.project.setCurrent', params: project };
- await Server.SET(sr);
+ const sr: Server.SetRequest<string, null> = {
+ kind: Server.RqKind.SET,
+ name: 'kernel.project.setCurrent',
+ input: Json.jString,
+ output: Json.jNull,
+ };
+ await Server.send(sr, project);
currentProject = project;
Dome.emit(PROJECT);
} catch (error) {
@@ -101,95 +91,51 @@ export async function setProject(project: string) {
}
// --------------------------------------------------------------------------
-// --- Projectified State
+// --- Cached GET Requests
// --------------------------------------------------------------------------
-function getValue(id: string, project?: string) {
- if (!project) return undefined;
- return _.get(states, [project, id], stateDefaults[id]);
-}
-
-function setValue(id: string, project: string | undefined, value: any) {
- if (!project) return;
- _.set(states, [project, id], value);
- Dome.emit(STATE + id, value);
+export interface UseRequestOptions<A> {
+ offline?: A | null;
+ pending?: A | null;
+ onError?: A | null;
}
/**
- * @summary Define the default state value.
- * @param {string} id - the state identifier (mandatory)
- * @param {any} value - the new default state
- */
-export function setStateDefault(id: string, value: any) {
- stateDefaults[id] = value;
-}
+ Cached GET request (Custom React Hook).
-/**
- * @summary Projectified State (Custom React Hook).
- * @param {string} id - the state identifier (mandatory)
- * @return {array} `[state,setState]` for the specified project
- * @description
- * Returns a getter and a setter for the specified state
- * in the specified or current project.
- * The initial value of states is always `undefined`.
- *
- * Each state is associated to a specific event `frama-c-state.<id>` which is
- * is used to notify updates. The hook also updates on `PROJECT` notifications.
- */
-export function useState(id: string) {
- Dome.useUpdate(PROJECT, STATE + id);
- const project = currentProject;
- const value = getValue(id, project);
- return [value, (v: any) => setValue(id, project, v)];
-}
+ Sends the specified GET request and returns its result.
+ The request is send asynchronously and cached until any change.
-// --------------------------------------------------------------------------
-// --- Cached GET Requests
-// --------------------------------------------------------------------------
-
-/**
- * @summary Cached GET request (Custom React Hook).
- * @param {string} rq - GET request name
- * @param {any} [params] - GET request parameter
- * @param {object} [options] - Special values
- * @param {any} [options.offline] - Returned value when off-line
- * @param {any} [options.pending] - Returned value when pending response
- * @param {any} [options.error] - Returned value on request error
- * @return {any} [result] GET request response (when available)
- * @description
- * Sends the specified GET request and returns its result.
- * The request is send asynchronously and cached until any change in
- * `rq`, `params`, current project or server activity.
- *
- * The request is considered off-line as soon as either `rq` or `params` or
- * current project takes a falsy value.
- *
- * Default values for various situations can be defined in the options
- * parameter, which is `undefined` unless specified, or `null` to keep the
- * current value.
- * For instance `{ pending: null }` will return `undefined` when off-line and
- * in case of errors, but will keep the last received value until a new one is
- * actually received.
+ Null values in options mean that the last obtained value is kept.
*/
-export function useRequest(rq: string, params: any, options: any = {}) {
+export function useRequest<In, Out>(
+ rq: Server.GetRequest<In, Out>,
+ params: In | undefined,
+ options: UseRequestOptions<Out> = {},
+): Out | undefined {
const state = React.useRef<string>();
const project = useProject();
- const [response, setResponse] = React.useState(options.offline);
- const footprint = project ? JSON.stringify([project, rq, params]) : undefined;
+ const [response, setResponse] =
+ React.useState<Out | undefined>(options.offline ?? undefined);
+ const footprint =
+ project ? JSON.stringify([project, rq.name, params]) : undefined;
+
+ const update = (opt: Out | undefined | null) => {
+ if (opt !== null) setResponse(opt);
+ };
async function trigger() {
if (project && rq && params !== undefined) {
try {
- const r = await Server.GET({ endpoint: rq, params });
- setResponse(r);
+ update(options.pending);
+ const r = await Server.send(rq, params);
+ update(r);
} catch (error) {
- PP.error(`Fail in useRequest '${rq}'. ${error.toString()}`);
- const err = options.error;
- setResponse(err);
+ PP.error(`Fail in useRequest '${rq.name}'. ${error.toString()}`);
+ update(options.onError);
}
} else {
- const off = options.offline;
- setResponse(off);
+ update(options.offline);
}
}
@@ -207,114 +153,121 @@ export function useRequest(rq: string, params: any, options: any = {}) {
// --- Dictionaries
// --------------------------------------------------------------------------
-/**
- * @summary Cached GET request (Custom React Hook).
- * @param {string} rq - GET request name
- * @param {any} [params] - GET request parameter (default `'null'`)
- * @param {object} [options] - Dictionary options
- * @param {boolean} [options.key] - The property to index an item
- * (default `'name'`)
- * @param {boolean} [options.offline] - Keep the dictionary when offline
- * (default `true`)
- * @param {boolean} [options.pending] - Keep the dictionary when pending
- * (default `true`)
- * @param {boolean} [options.error] - Keep the dictionary on error
- * (default `false`)
- * @param {function} [options.filter] - Only index items satisfying the filter
- * (default `undefined`)
- * @return {object} [result] GET request response indexed by key
- * @description
- * Sends the specified GET request and returns its returned collection indexed
- * by the provided key.
- * Items in the collection that do have the key are not indexed.
- */
-export function useDictionary(
- rq: string,
- params: any = null,
- options: any = {},
-) {
- const {
- offline = true,
- pending = true,
- error = false,
- key = 'name',
- filter,
- } = options;
- const tags = useRequest(rq, params, {
- offline: offline ? null : undefined,
- pending: pending ? null : undefined,
- error: error ? null : undefined,
- });
- const dict = React.useMemo(() => {
- const d: any = {};
- _.forEach(tags, (tg) => {
- const k: any = tg[key];
- if (k && (!filter || filter(tg))) d[k] = tg;
- });
- return d;
- }, [key, tags, filter]);
- return dict;
+export type Tag = {
+ name: string;
+ label?: string;
+ descr?: string;
+};
+
+const holdCurrent = { offline: null, pending: null, onError: null };
+
+export type GetTags = Server.GetRequest<null, Tag[]>;
+
+export function useTags(rq: GetTags): Map<string, Tag> {
+ const tags = useRequest(rq, null, holdCurrent);
+ return React.useMemo(() => {
+ const m = new Map<string, Tag>();
+ if (tags !== undefined)
+ tags.forEach((tg) => m.set(tg.name, tg));
+ return m;
+ }, [tags]);
}
// --------------------------------------------------------------------------
// --- Synchronized States
// --------------------------------------------------------------------------
+export interface Value<A> {
+ name: string;
+ signal: Server.Signal;
+ getter: Server.GetRequest<null, A>;
+}
+
+export interface State<A> {
+ name: string;
+ signal: Server.Signal;
+ getter: Server.GetRequest<null, A>;
+ setter: Server.SetRequest<A, null>;
+}
+
+export interface Fetches<K, A> {
+ reload: boolean;
+ pending: number;
+ updated: A[];
+ removed: K[];
+}
+
+export interface Array<K, A> {
+ name: string;
+ order: Order<A>;
+ getkey: (row: A) => K;
+ signal: Server.Signal;
+ reload: Server.GetRequest<null, null>;
+ fetch: Server.GetRequest<number, Fetches<K, A>>;
+}
+
+// --------------------------------------------------------------------------
+// --- Handler for Synchronized St byates
+// --------------------------------------------------------------------------
+
+interface Handler<A> {
+ name: string;
+ signal: Server.Signal;
+ getter: Server.GetRequest<null, A>;
+ setter?: Server.SetRequest<A, null>;
+}
+
// shared for all projects
-class SyncState {
- id: any;
+class SyncState<A> {
UPDATE: string;
- signal: string;
- getRq: string;
- setRq: string;
- insync: boolean;
- effect: any;
- value: undefined;
-
- constructor(id: any) {
- this.id = id;
- this.UPDATE = STATE + id;
- this.signal = `${id}.sig`;
- this.getRq = `${id}.get`;
- this.setRq = `${id}.set`;
- this.insync = false;
+ handler: Handler<A>;
+ upToDate: boolean;
+ value?: A;
+
+ constructor(h: Handler<A>) {
+ this.handler = h;
+ this.UPDATE = STATE_PREFIX + h.name;
+ this.upToDate = false;
this.value = undefined;
this.update = this.update.bind(this);
- this.effect = this.effect.bind(this);
+ this.getValue = this.getValue.bind(this);
this.setValue = this.setValue.bind(this);
Dome.on(PROJECT, this.update);
}
getValue() {
- if (!this.insync && Server.isRunning()) {
+ if (!this.upToDate && Server.isRunning()) {
this.update();
}
return this.value;
}
- async setValue(v: any) {
+ async setValue(v: A) {
try {
- this.insync = true;
+ this.upToDate = true;
this.value = v;
- const sr: Server.Request = { endpoint: this.setRq, params: v };
- await Server.SET(sr);
+ const setter = this.handler.getter;
+ if (setter) await Server.send(setter, v);
Dome.emit(this.UPDATE);
} catch (error) {
PP.error(
- `Fail to set value of syncState '${this.id}'. ${error.toString()}`,
+ `Fail to set value of syncState '${this.handler.name}'.`,
+ `${error.toString()}`,
);
}
}
async update() {
try {
- this.insync = true;
- const sr: Server.Request = { endpoint: this.getRq, params: {} };
- const v = await Server.GET(sr);
+ this.upToDate = true;
+ const v = await Server.send(this.handler.getter, null);
this.value = v;
Dome.emit(this.UPDATE);
} catch (error) {
- PP.error(`Fail to update syncState '${this.id}'. ${error.toString()}`);
+ PP.error(
+ `Fail to update syncState '${this.handler.name}'.`,
+ `${error.toString()}`,
+ );
}
}
}
@@ -323,54 +276,44 @@ class SyncState {
// --- Synchronized States Registry
// --------------------------------------------------------------------------
-let syncStates: any = {};
+const syncStates = new Map<string, SyncState<any>>();
-function getSyncState(id: any) {
- let s: any = syncStates[id];
+function getSyncState<A>(h: Handler<A>): SyncState<A> {
+ const id = `${currentProject}@${h.name}`;
+ let s = syncStates.get(id);
if (!s) {
- syncStates[id] = new SyncState(id);
- s = syncStates[id];
+ s = new SyncState(h);
+ syncStates.set(id, s);
}
return s;
}
-Server.onShutdown(() => (syncStates = {}));
+Server.onShutdown(() => syncStates.clear());
// --------------------------------------------------------------------------
// --- Synchronized State Hooks
// --------------------------------------------------------------------------
/**
- * @summary Use Synchronized State (Custom React Hook).
- * @parameter {string} id - name of the server state
- * @return {Array} `[ value , setValue ]` of the synchronized state
- * @description
- * Synchronization with some (projectified) server state:
- * - sends a `<id>.get` request to obtain the current value of the state;
- * - sends a `<id>.set` request to update the value of the state;
- * - listens to `<id>.sig` signal to stay in sync with server updates.
+ Synchronization with a (projectified) server state.
*/
-export function useSyncState(id: string) {
- const s = getSyncState(id);
+export function useSyncState<A>(
+ st: State<A>,
+): [A | undefined, (value: A) => void] {
+ const s = getSyncState(st);
Dome.useUpdate(PROJECT, s.UPDATE);
- Server.useSignal(s.signal, s.update);
- return [s.value(), s.setValue];
+ Server.useSignal(s.handler.signal, s.update);
+ return [s.getValue(), s.setValue];
}
/**
- * @summary Use Synchronized Value (Custom React Hook).
- * @parameter {string} id - name of the server state
- * @return {any} current `value` of the state
- * @description
- * Synchronization with some (projectified) server value:
- * - sends a `<id>.get` request to obtain the current value of the state;
- * - listens to `<id>.sig` signal to stay in sync with server updates.
+ Synchronization with a (projectified) server value.
*/
-export function useSyncValue(id: string) {
- const s = getSyncState(id);
+export function useSyncValue<A>(va: Value<A>): A | undefined {
+ const s = getSyncState(va);
Dome.useUpdate(s.update);
- Server.useSignal(s.signal, s.update);
- return s.value();
+ Server.useSignal(s.handler.signal, s.update);
+ return s.getValue();
}
// --------------------------------------------------------------------------
@@ -378,129 +321,138 @@ export function useSyncValue(id: string) {
// --------------------------------------------------------------------------
// one per project
-class SyncArray {
- id: string;
- UPDATE: string;
- signal: string;
- fetchRq: string;
- reloadRq: string;
- index: any;
- insync: boolean;
-
- constructor(id: string) {
- this.id = id;
- this.UPDATE = STATE + id;
- this.signal = `${id}.sig`;
- this.fetchRq = `${id}.fetch`;
- this.reloadRq = `${id}.reload`;
- this.index = {};
- this.insync = false;
+class SyncArray<K, A> {
+ handler: Array<K, A>;
+ upToDate: boolean;
+ fetching: boolean;
+ model: CompactModel<K, A>;
+
+ constructor(h: Array<K, A>) {
+ this.handler = h;
+ this.fetching = false;
+ this.upToDate = false;
+ this.model = new CompactModel(h.getkey);
+ this.model.setNaturalOrder(h.order);
this.fetch = this.fetch.bind(this);
this.reload = this.reload.bind(this);
+ this.update = this.update.bind(this);
}
- getItems() {
- if (!this.insync && Server.isRunning()) this.fetch();
- return this.index;
- }
-
- isEmpty() {
- return _.find(this.index, () => true) !== undefined;
+ update() {
+ if (!this.upToDate && Server.isRunning()) this.fetch();
}
async fetch() {
+ if (this.fetching || !Server.isRunning()) return;
try {
- this.insync = true;
- const sr: Server.Request = { endpoint: this.fetchRq, params: 50 };
- const data = await Server.GET(sr);
- const { reload = false, removed = [], updated = [], pending = 0 } = data;
- let reloaded = false;
- if (reload) {
- reloaded = this.isEmpty();
- this.index = {};
- }
- removed.forEach((key: any) => {
- delete this.index[key];
- });
- updated.forEach((item: any) => {
- this.index[item.key] = item;
- });
- if (reloaded || removed.length || updated.length) {
- this.index = { ...this.index };
- Dome.emit(this.UPDATE);
- }
- if (pending > 0) {
- this.fetch();
- }
+ this.fetching = true;
+ let pending;
+ /* eslint-disable no-await-in-loop */
+ do {
+ const data = await Server.send(this.handler.fetch, 50);
+ const { reload = false, removed = [], updated = [] } = data;
+ const { model } = this;
+ if (reload) model.removeAllData();
+ model.updateData(updated);
+ model.removeData(removed);
+ if (reload || updated.length > 0 || removed.length > 0)
+ model.reload();
+ pending = data.pending ?? 0;
+ } while (pending > 0);
+ /* eslint-enable no-await-in-loop */
} catch (error) {
PP.error(
- `Fail to retrieve the value of syncArray '${this.id}. ` +
+ `Fail to retrieve the value of syncArray '${this.handler.name}.`,
`${error.toString()}`,
);
+ } finally {
+ this.fetching = false;
+ this.upToDate = true;
}
}
async reload() {
try {
- const sr: Server.Request = { endpoint: this.reloadRq, params: {} };
- await Server.SET(sr);
- this.index = {};
- this.insync = false;
- Dome.emit(this.UPDATE);
+ this.model.clear();
+ this.upToDate = false;
+ if (Server.isRunning()) {
+ await Server.send(this.handler.reload, null);
+ this.fetch();
+ }
} catch (error) {
PP.error(
- `Fail to set reload of syncArray '${this.id}'. ${error.toString()}`,
+ `Fail to set reload of syncArray '${this.handler.name}'.`,
+ `${error.toString()}`,
);
}
}
+
}
// --------------------------------------------------------------------------
// --- Synchronized Arrays Registry
// --------------------------------------------------------------------------
-let syncArrays = {}; // Model by project & id
+const syncArrays = new Map<string, SyncArray<any, any>>();
-function getSyncArray(id: string) {
- const path = [currentProject || '', id];
- let a = _.get(syncArrays, path);
- if (!a) {
- a = new SyncArray(id);
- _.set(syncArrays, path, a);
+function getSyncArray<K, A>(
+ array: Array<K, A>,
+): SyncArray<K, A> {
+ const id = `${currentProject}@${array.name}`;
+ let st = syncArrays.get(id);
+ if (!st) {
+ st = new SyncArray(array);
+ syncArrays.set(id, st);
}
- return a;
+ return st;
}
-Server.onShutdown(() => (syncArrays = {}));
+Server.onShutdown(() => syncArrays.clear());
// --------------------------------------------------------------------------
// --- Synchronized Array Hooks
// --------------------------------------------------------------------------
/**
- * @summary Force a Synchronized Array to Reload.
- * @description
- * Sends the `<id>.reload` request to the server for
- * triggering a complete array reload.
+ Force a Synchronized Array to Reload.
+*/
+export function reloadArray<K, A>(arr: Array<K, A>) {
+ getSyncArray(arr).reload();
+}
+
+/**
+ Use Synchronized Array (Custom React Hook).
+ This React Hook is _not_ responsive to model updates, it only
+ returns the array model.
+ To listen to array updates, use `Models.useModel(model)` or `useSyncArray()`.
+ Array views automatically listen to model updates.
*/
-export function reloadArray(id: string) {
- getSyncArray(id).reload();
+export function useSyncModel<K, A>(
+ arr: Array<K, A>,
+): CompactModel<K, A> {
+ Dome.useUpdate(PROJECT);
+ const st = getSyncArray(arr);
+ React.useEffect(st.update);
+ Server.useSignal(arr.signal, st.fetch);
+ return st.model;
}
/**
- * @summary Use Synchronized Array (Custom React Hook).
- * @parameter {string} id - name of the server array
- * @return {object} items indexed by their identifiers
- * @description
- * Synchronization with some (projectified) server array:
- * - sends `<id>.fetch` requests to obtain the updated entries;
- * - listens to `<id>.sig` signal to stay in sync with server updates.
+ Use Synchronized Array (Custom React Hook).
+ This React Hook is _not_ responsive to model updates, it only
+ returns the array model.
+ To listen to array updates, use `Models.useModel(model)` or `useSyncArray()`.
+ Array views automatically listen to model updates.
*/
-export function useSyncArray(id: string) {
- const a = getSyncArray(id);
- Dome.useUpdate(PROJECT, a.UPDATE);
- Server.useSignal(a.signal, a.fetch);
- return a.getItems();
+export function useSyncArray<K, A>(
+ arr: Array<K, A>,
+): A[] {
+ Dome.useUpdate(PROJECT);
+ const st = getSyncArray(arr);
+ React.useEffect(st.update);
+ Server.useSignal(arr.signal, st.fetch);
+ useModel(st.model);
+ return st.model.getArray();
}
// --------------------------------------------------------------------------
@@ -727,25 +679,20 @@ function reducer(s: Selection, action: SelectionActions): Selection {
}
}
-const SELECTION = 'kernel.selection';
-
-const initialSelection = {
+const GlobalSelection = new GlobalStates.State<Selection>({
current: undefined,
history: {
prevSelections: [],
nextSelections: [],
},
- multiple: [],
- index: 0,
-};
-setStateDefault(SELECTION, initialSelection);
+ multiple: { index: 0, allSelections: [] }
+});
/**
- * Current selection.
- * @return {array} The current selection and the function to update it.
+ Current selection.
*/
export function useSelection(): [Selection, (a: SelectionActions) => void] {
- const [selection, setSelection] = useState(SELECTION);
+ const [selection, setSelection] = GlobalStates.useState(GlobalSelection);
function update(action: SelectionActions) {
const nextSelection = reducer(selection, action);
diff --git a/ivette/src/renderer/ASTinfo.tsx b/ivette/src/renderer/ASTinfo.tsx
index 6f3fb2bdca78057b36a6cc80b34e8c2c39af5343..8fbe76d591654ebd57f77fb6be7d1b0f9d3039a0 100644
--- a/ivette/src/renderer/ASTinfo.tsx
+++ b/ivette/src/renderer/ASTinfo.tsx
@@ -10,6 +10,8 @@ import { RichTextBuffer } from 'dome/text/buffers';
import { Text } from 'dome/text/editors';
import { Component } from 'frama-c/LabViews';
+import { getInfo } from 'api/kernel/ast';
+
// --------------------------------------------------------------------------
// --- Information Panel
// --------------------------------------------------------------------------
@@ -19,17 +21,11 @@ const ASTinfo = () => {
const buffer = React.useMemo(() => new RichTextBuffer(), []);
const [selection, updateSelection] = States.useSelection();
const marker = selection?.current?.marker;
- const data = States.useRequest(
- 'kernel.ast.info',
- marker,
- { offline: undefined },
- );
+ const data = States.useRequest(getInfo, marker);
React.useEffect(() => {
buffer.clear();
- if (data) {
- buffer.printTextWithTags(data, { css: 'color: blue' });
- }
+ buffer.printTextWithTags(data, { css: 'color: blue' });
}, [buffer, data]);
// Callbacks
diff --git a/ivette/src/renderer/ASTview.tsx b/ivette/src/renderer/ASTview.tsx
index cd4528edc6ce74384e11ac2dc4b0cbd94e5a4f80..6b25000a946940fb4a337f69189fb12baec40a6d 100644
--- a/ivette/src/renderer/ASTview.tsx
+++ b/ivette/src/renderer/ASTview.tsx
@@ -7,11 +7,15 @@ import * as Server from 'frama-c/server';
import * as States from 'frama-c/states';
import * as Dome from 'dome';
+import { key } from 'dome/data/json';
import { RichTextBuffer } from 'dome/text/buffers';
import { Text } from 'dome/text/editors';
import { IconButton } from 'dome/controls/buttons';
import { Component, TitleBar } from 'frama-c/LabViews';
+import { printFunction, markerInfo } from 'api/kernel/ast';
+import { getCallers } from 'api/plugins/eva';
+
import 'codemirror/mode/clike/clike';
import 'codemirror/theme/ambiance.css';
import 'codemirror/theme/solarized.css';
@@ -41,10 +45,7 @@ async function loadAST(
buffer.log('// Loading', theFunction, '…');
(async () => {
try {
- const data = await Server.GET({
- endpoint: 'kernel.ast.printFunction',
- params: theFunction,
- });
+ const data = await Server.send(printFunction, theFunction);
buffer.operation(() => {
buffer.clear();
if (!data) {
@@ -69,13 +70,8 @@ async function functionCallers(
kf: string,
) {
try {
- const data = await Server.GET({
- endpoint: 'eva.callers',
- params: kf,
- });
- const locations = data.map((d: string[2]) => (
- { function: d[0], marker: d[1] }
- ));
+ const data = await Server.send(getCallers, null);
+ const locations = data.map(([fct, marker]) => ({ function: fct, marker }));
updateSelection({ locations });
} catch (err) {
PP.error(`Fail to retrieve callers of function ${kf}`, err);
@@ -96,7 +92,7 @@ const ASTview = () => {
const [theme, setTheme] = Dome.useGlobalSetting('ASTview.theme', 'default');
const [fontSize, setFontSize] = Dome.useGlobalSetting('ASTview.fontSize', 12);
const [wrapText, setWrapText] = Dome.useSwitch('ASTview.wrapText', false);
- const markers = States.useSyncArray('kernel.ast.markerKind');
+ const markers = States.useSyncModel(markerInfo);
const theFunction = selection?.current?.function;
const theMarker = selection?.current?.marker;
@@ -127,17 +123,17 @@ const ASTview = () => {
const zoomIn = () => fontSize < 48 && setFontSize(fontSize + 2);
const zoomOut = () => fontSize > 4 && setFontSize(fontSize - 2);
- function onTextSelection(id: string) {
+ function onTextSelection(id: key<'#markerIndo'>) {
if (selection.current) {
const location = { ...selection.current, marker: id };
updateSelection({ location });
}
}
- function onContextMenu(id: string) {
+ function onContextMenu(id: key<'#markerInfo'>) {
const items = [];
- const marker = markers[id];
- if (marker?.kind === 'lvalue' && marker?.var === 'function') {
+ const marker = markers.getData(id);
+ if (marker?.kind === 'function') {
items.push({
label: `Go to definition of ${marker.name}`,
onClick: () => {
@@ -146,9 +142,7 @@ const ASTview = () => {
},
});
}
- if (marker?.kind === 'declaration'
- && marker?.var === 'function'
- && marker?.name) {
+ if (marker?.kind === 'declaration' && marker?.name) {
items.push({
label: 'Go to callers',
onClick: () => functionCallers(updateSelection, marker.name),
diff --git a/ivette/src/renderer/Controller.tsx b/ivette/src/renderer/Controller.tsx
index 01d73e3cb1486b920d9fbd9e812189eac70cbe75..699fa98dc8a2018dc87afac4848253179e67aaad 100644
--- a/ivette/src/renderer/Controller.tsx
+++ b/ivette/src/renderer/Controller.tsx
@@ -169,17 +169,10 @@ const editor = new RichTextBuffer();
const RenderConsole = () => {
const scratch = React.useRef([] as string[]);
const [cursor, setCursor] = React.useState(-1);
- const [H0, setH0] = Dome.useState('Controller.history', []);
+ const [history, setHistory] = Dome.useState('Controller.history', []);
const [isEmpty, setEmpty] = React.useState(true);
const [noTrash, setNoTrash] = React.useState(true);
- // Cope with merge settings that keeps previous array entries (BUG in DOME)
- const history = Array.isArray(H0) ? H0.filter((h) => h !== '') : [];
- const setHistory = (hs: string[]) => {
- const n = hs.length;
- setH0(n < 50 ? hs.concat(Array(50 - n).fill('')) : hs);
- };
-
Dome.useEmitter(editor, 'change', () => {
const cmd = editor.getValue().trim();
setEmpty(cmd === '');
diff --git a/ivette/src/renderer/Globals.tsx b/ivette/src/renderer/Globals.tsx
index 62a3c702e9b56067a1c3acb5cf63148e1867e5bb..edc8a40d566418f9a37dbee6f896187dbf07dd02 100644
--- a/ivette/src/renderer/Globals.tsx
+++ b/ivette/src/renderer/Globals.tsx
@@ -3,22 +3,10 @@
// --------------------------------------------------------------------------
import React from 'react';
-import { toArray, Dictionary } from 'lodash';
import { Section, Item } from 'dome/frame/sidebars';
import * as States from 'frama-c/states';
import { alpha } from 'dome/data/compare';
-
-// --------------------------------------------------------------------------
-// --- Globals API
-// --------------------------------------------------------------------------
-
-interface Gfun {
- key: string;
- name: string;
- signature: string;
-}
-
-type Gfuns = undefined | Dictionary<Gfun>;
+import { functions, functionsData } from 'api/kernel/ast';
// --------------------------------------------------------------------------
// --- Globals Section
@@ -28,13 +16,13 @@ export default () => {
// Hooks
const [selection, updateSelection] = States.useSelection();
- const gfuns: Gfuns = States.useSyncArray('kernel.ast.functions');
-
- // Functions
- const functions = toArray(gfuns).sort((f1, f2) => alpha(f1.name, f2.name));
+ const fcts = States.useSyncArray(functions).sort(
+ (f, g) => alpha(f.name, g.name),
+ );
+ // Items
const current: undefined | string = selection?.current?.function;
- const makeFctItem = (fct: Gfun) => {
+ const makeFctItem = (fct: functionsData) => {
const kf = fct.name;
return (
<Item
@@ -49,7 +37,7 @@ export default () => {
return (
<Section label="Functions">
- {functions.map(makeFctItem)}
+ {fcts.map(makeFctItem)}
</Section>
);
diff --git a/ivette/src/renderer/MultipleSelection.tsx b/ivette/src/renderer/MultipleSelection.tsx
index 3edb1ddaa1ca2c6d515c545b1545f21be019d482..3c887147c51f3bee3ccf3d39b7d04c9f89f24bbc 100644
--- a/ivette/src/renderer/MultipleSelection.tsx
+++ b/ivette/src/renderer/MultipleSelection.tsx
@@ -5,7 +5,7 @@
import React from 'react';
import * as States from 'frama-c/states';
-import { ArrayModel } from 'dome/table/arrays';
+import { CompactModel } from 'dome/table/arrays';
import { Table, Column } from 'dome/table/views';
import { Label } from 'dome/controls/labels';
import * as Toolbar from 'dome/frame/toolbars';
@@ -15,20 +15,23 @@ import { Component } from 'frama-c/LabViews';
// --- Multiple Selection Panel
// --------------------------------------------------------------------------
+type SelectionId = States.Location & { id: number };
+
const SelectionTable = () => {
// Hooks
const [selection, updateSelection] = States.useSelection();
- const model = React.useMemo(() => new ArrayModel('id'), []);
-
- const multiple = selection?.multiple;
+ const model = React.useMemo(() => (
+ new CompactModel<number, SelectionId>(({ id }: SelectionId) => id)
+ ), []);
+ const multiple: States.MultipleSelection = selection?.multiple;
const numblerOfSelections = multiple?.allSelections?.length;
// Updates [[model]] with the current multiple selection.
React.useEffect(() => {
if (numblerOfSelections > 0) {
- const array = multiple.allSelections.map((d, i) => ({ ...d, id: i }));
- model.replace(array);
+ const array: SelectionId[] = multiple.allSelections.map((d, i) => ({ ...d, id: i }));
+
} else
model.clear();
}, [numblerOfSelections, multiple, model]);
diff --git a/ivette/src/renderer/Properties.tsx b/ivette/src/renderer/Properties.tsx
index 14a89985336f099d8cd405490d8a1f71d22c208e..e2a434f7a7e0743ff27b63b55aa4ac0d0f9d5fa5 100644
--- a/ivette/src/renderer/Properties.tsx
+++ b/ivette/src/renderer/Properties.tsx
@@ -3,12 +3,14 @@
// --------------------------------------------------------------------------
import _ from 'lodash';
-import React from 'react';
+import React, { useEffect } from 'react';
import * as Dome from 'dome';
+import { key } from 'dome/data/json';
import * as States from 'frama-c/states';
import * as Compare from 'dome/data/compare';
import { Label, Code } from 'dome/controls/labels';
import { IconButton } from 'dome/controls/buttons';
+import * as Models from 'dome/table/models';
import * as Arrays from 'dome/table/arrays';
import { Table, Column, ColumnProps, Renderer } from 'dome/table/views';
import { TitleBar, Component } from 'frama-c/LabViews';
@@ -16,6 +18,10 @@ import { Vfill } from 'dome/layout/boxes';
import { Splitter } from 'dome/layout/splitters';
import { Form, Section, FieldCheckbox } from 'dome/layout/forms';
+import { source as SourceLoc } from 'api/kernel/services';
+import { statusData as Property } from 'api/kernel/properties';
+import * as Properties from 'api/kernel/properties';
+
// --------------------------------------------------------------------------
// --- Filters
// --------------------------------------------------------------------------
@@ -29,7 +35,6 @@ const defaultStatusFilter =
invalid_hyp: true,
considered_valid: false,
untried: false,
- dead: false,
inconsistent: true,
};
@@ -83,8 +88,10 @@ const defaultFilter =
alarms: defaultAlarmsFilter,
};
-
-function filterStatus(f: typeof defaultStatusFilter, status: string) {
+function filterStatus(
+ f: typeof defaultStatusFilter,
+ status: Properties.propStatus,
+) {
switch (status) {
case 'valid':
case 'valid_but_dead': return f.valid;
@@ -96,27 +103,30 @@ function filterStatus(f: typeof defaultStatusFilter, status: string) {
case 'unknown_but_dead': return f.unknown;
case 'considered_valid': return f.considered_valid;
case 'never_tried': return f.untried;
- case 'dead': return f.dead;
case 'inconsistent': return f.inconsistent;
default: return true;
}
}
-function filterKind(f: typeof defaultKindFilter, kind: string) {
+function filterKind(
+ f: typeof defaultKindFilter,
+ kind: Properties.propKind,
+) {
switch (kind) {
case 'assert': return f.assert;
- case 'invariant': return f.invariant;
- case 'variant': return f.variant;
+ case 'loop_invariant':
+ return f.invariant;
+ case 'loop_variant': return f.variant;
case 'requires': return f.requires;
case 'ensures': return f.ensures;
case 'instance': return f.instance;
case 'assigns': return f.assigns;
- case 'from': return f.from;
+ case 'froms': return f.from;
case 'allocates': return f.allocates;
case 'behavior': return f.behavior;
case 'reachable': return f.reachable;
case 'axiomatic': return f.axiomatic;
- case 'pragma': return f.pragma;
+ case 'loop_pragma': return f.pragma;
default: return f.others;
}
}
@@ -160,10 +170,8 @@ function filterProperty(f: typeof defaultFilter, item: Property) {
const renderCode: Renderer<string> =
(text: string) => (<Code className="code-column" title={text}>{text}</Code>);
-interface Tag { name: string; label: string; descr: string }
-
-const renderTag: Renderer<Tag> =
- (d: Tag) => <Label label={d.label} title={d.descr} />;
+const renderTag: Renderer<States.Tag> =
+ (d: States.Tag) => <Label label={d.label ?? d.name} title={d.descr} />;
const renderNames: Renderer<string[]> =
(names: string[]) => {
@@ -185,7 +193,7 @@ function ColumnCode<Row>(props: ColumnProps<Row, string>) {
return <Column render={renderCode} {...props} />;
}
-function ColumnTag<Row>(props: ColumnProps<Row, Tag>) {
+function ColumnTag<Row>(props: ColumnProps<Row, States.Tag>) {
return <Column render={renderTag} {...props} />;
}
@@ -193,26 +201,6 @@ function ColumnTag<Row>(props: ColumnProps<Row, Tag>) {
// --- Properties Table
// -------------------------------------------------------------------------
-interface SourceLoc {
- dir: string;
- base: string;
- file: string;
- line: number;
-}
-
-interface Property {
- key: string;
- descr: string;
- kind: string;
- alarm?: string;
- names: string[];
- predicate: string;
- status: string;
- function?: string;
- kinstr: string;
- source: SourceLoc;
-}
-
const bySource =
Compare.byFields<SourceLoc>({ file: Compare.alpha, line: Compare.primitive });
@@ -235,12 +223,12 @@ const byProperty: Compare.ByFields<Property> = {
status: byStatus,
function: Compare.defined(Compare.alpha),
source: bySource,
- kind: Compare.primitive,
+ kind: Compare.structural,
alarm: Compare.defined(Compare.alpha),
names: Compare.array(Compare.alpha),
predicate: Compare.defined(Compare.alpha),
key: Compare.primitive,
- kinstr: Compare.primitive,
+ kinstr: Compare.structural,
};
const byDir = Compare.byFields<SourceLoc>({ dir: Compare.alpha });
@@ -251,13 +239,13 @@ const byColumn: Arrays.ByColumns<Property> = {
file: Compare.byFields<Property>({ source: byFile }),
};
-class PropertyModel extends Arrays.ArrayModel<Property> {
+class PropertyModel extends Arrays.CompactModel<key<'#status'>, Property> {
private filterFun?: string;
private filterProp = _.cloneDeep(defaultFilter);
constructor() {
- super('key');
+ super((p: Property) => p.key);
this.setOrderingByFields(byProperty);
this.setColumnOrder(byColumn);
this.setFilter(this.filterItem.bind(this));
@@ -359,26 +347,23 @@ const PropertyFilter =
const PropertyColumns = () => {
- const statusDict: { [status: string]: Tag } =
- States.useDictionary('kernel.dictionary.propstatus');
- const kindDict: { [kind: string]: Tag } =
- States.useDictionary('kernel.dictionary.propkind');
- const alarmDict: { [alarm: string]: Tag } =
- States.useDictionary('kernel.dictionary.alarmkind');
+ const statusDict = States.useTags(Properties.propStatusTags);
+ const kindDict = States.useTags(Properties.propKindTags);
+ const alarmDict = States.useTags(Properties.alarmsTags);
const getStatus = React.useCallback(
- ({ status: st }: Property) => (statusDict[st] ?? { label: st }),
+ ({ status: st }: Property) => (statusDict.get(st) ?? { name: st }),
[statusDict],
);
const getKind = React.useCallback(
- ({ kind }: Property) => (kindDict[kind] ?? { label: kind }),
+ ({ kind: kd }: Property) => (kindDict.get(kd) ?? { name: kd }),
[kindDict],
);
const getAlarm = React.useCallback(
({ alarm }: Property) => (
- alarm === undefined ? alarm : (alarmDict[alarm] ?? { label: alarm })
+ alarm === undefined ? alarm : (alarmDict.get(alarm) ?? { name: alarm })
),
[alarmDict],
);
@@ -426,19 +411,13 @@ const PropertyColumns = () => {
};
function FilterRatio({ model }: { model: PropertyModel }) {
- const forceUpdate = Dome.useForceUpdate() as (() => void);
- React.useEffect(() => {
- const client = model.link();
- client.onReload(forceUpdate);
- return client.unlink;
- });
- const filtered = model.getRowCount();
- const total = model.getTotalRowCount();
+ Models.useModel(model);
+ const [filtered, total] = [model.getRowCount(), model.getTotalRowCount()];
return (
<Label
className="component-info"
title="Displayed Properties / Total"
- display={filtered !== total}
+ display={filtered !== total || true}
>
{filtered} / {total}
</Label>
@@ -452,32 +431,29 @@ function FilterRatio({ model }: { model: PropertyModel }) {
const RenderTable = () => {
// Hooks
const model = React.useMemo(() => new PropertyModel(), []);
- const properties: { [key: string]: Property } =
- States.useSyncArray('kernel.properties');
+ const data = States.useSyncArray(Properties.status);
+ useEffect(() => {
+ model.removeAllData();
+ model.updateData(data);
+ model.reload();
+ }, [model, data]);
const [selection, updateSelection] = States.useSelection();
const [showFilter, flipFilter] =
Dome.useSwitch('ivette.properties.showFilter', true);
- // Populating the model
- React.useEffect(() => {
- const data = _.toArray(properties);
- model.replace(data);
- }, [model, properties]);
-
// Updating the filter
const selectedFunction = selection?.current?.function;
React.useEffect(() => {
model.setFilterFunction(selectedFunction);
}, [model, selectedFunction]);
-
// Callbacks
const onPropertySelection = React.useCallback(
- ({ key, function: fct }: Property) => {
- const location = { function: fct, marker: key };
+ ({ key: propKey, function: fct }: Property) => {
+ const location = { function: fct, marker: propKey };
updateSelection({ location });
}, [updateSelection],
);
diff --git a/ivette/tsconfig.json b/ivette/tsconfig.json
index 2ffcf2dace25523e759dfe5a1a2013a06db183ce..662e4cd16a733b51a4544a219c7f8dd005d7b761 100644
--- a/ivette/tsconfig.json
+++ b/ivette/tsconfig.json
@@ -43,6 +43,7 @@
"resolveJsonModule": true, /* Allow to load JSON files as module. */
"baseUrl": ".", /* Base directory to resolve non-absolute module names. */
"paths": { /* A series of entries which re-map imports to lookup locations relative to the 'baseUrl'. */
+ "api/*": [ "api/*" ],
"frama-c/*": [ "src/frama-c/*" ],
"dome": [ "src/dome/src/renderer/dome.js" ],
"dome/system": [ "src/dome/src/misc/system.js" ],
@@ -71,7 +72,8 @@
"forceConsistentCasingInFileNames": true /* Disallow inconsistently-cased references to the same file. */
},
"include": [
- "src/**/*"
+ "src/**/*",
+ "api/**/*"
],
"exclude": [
"node_modules",
@@ -96,8 +98,8 @@
"readme": "./README.md",
"inputFiles": [
"doc/pages",
- "src/frama-c",
- "src/dome/src/renderer"
+ "src/frama-c", "api",
+ "src/dome/src/renderer",
]
}
}
diff --git a/ivette/webpack.renderer.js b/ivette/webpack.renderer.js
index 55008fe5010fcbcc362e686e0ea54c4870a7eaa2..e35b929d4766762beef45a01ecd3b55126716021 100644
--- a/ivette/webpack.renderer.js
+++ b/ivette/webpack.renderer.js
@@ -26,6 +26,7 @@ module.exports = {
resolve: {
extensions: ['.ts', '.tsx', '.js', 'jsx', '.json'],
alias: {
+ 'api': path.resolve( __dirname , 'api' ),
'frama-c': path.resolve( __dirname , 'src/frama-c' ),
'@plugins': path.resolve( __dirname , 'src/plugins' ),
'dome/misc': path.resolve( DOME , 'src/misc' ),
diff --git a/ivette/yarn.lock b/ivette/yarn.lock
index 7be39fad855443cb9b03db8b55b67c6a0b192ecf..326cb44b75057094cf39c1457749096978a8f9f6 100644
--- a/ivette/yarn.lock
+++ b/ivette/yarn.lock
@@ -868,15 +868,22 @@
"@babel/helper-plugin-utils" "^7.8.3"
"@babel/plugin-transform-typescript" "^7.9.0"
-"@babel/runtime-corejs3@^7.8.3":
- version "7.9.2"
- resolved "https://registry.yarnpkg.com/@babel/runtime-corejs3/-/runtime-corejs3-7.9.2.tgz#26fe4aa77e9f1ecef9b776559bbb8e84d34284b7"
- integrity sha512-HHxmgxbIzOfFlZ+tdeRKtaxWOMUoCG5Mu3wKeUmOxjYrwb3AAHgnmtCUbPPK11/raIWLIBK250t8E2BPO0p7jA==
+"@babel/runtime-corejs3@^7.10.2":
+ version "7.10.4"
+ resolved "https://registry.yarnpkg.com/@babel/runtime-corejs3/-/runtime-corejs3-7.10.4.tgz#f29fc1990307c4c57b10dbd6ce667b27159d9e0d"
+ integrity sha512-BFlgP2SoLO9HJX9WBwN67gHWMBhDX/eDz64Jajd6mR/UAUzqrNMm99d4qHnVaKscAElZoFiPv+JpR/Siud5lXw==
dependencies:
core-js-pure "^3.0.0"
regenerator-runtime "^0.13.4"
-"@babel/runtime@^7.4.5", "@babel/runtime@^7.8.4", "@babel/runtime@^7.8.7", "@babel/runtime@^7.9.2":
+"@babel/runtime@^7.10.2":
+ version "7.10.4"
+ resolved "https://registry.yarnpkg.com/@babel/runtime/-/runtime-7.10.4.tgz#a6724f1a6b8d2f6ea5236dbfe58c7d7ea9c5eb99"
+ integrity sha512-UpTN5yUJr9b4EX2CnGNWIvER7Ab83ibv0pcvvHc4UOdrBI5jb8bj+32cCwPX6xu0mt2daFNjYhoi+X7beH0RSw==
+ dependencies:
+ regenerator-runtime "^0.13.4"
+
+"@babel/runtime@^7.8.4", "@babel/runtime@^7.8.7", "@babel/runtime@^7.9.2":
version "7.9.2"
resolved "https://registry.yarnpkg.com/@babel/runtime/-/runtime-7.9.2.tgz#d90df0583a3a252f09aaa619665367bae518db06"
integrity sha512-NE2DtOdufG7R5vnfQUTehdTfNycfUANEtCa9PssN9O/xmTzP4E08UI797ixaei6hBEVL9BI/PsdJS5x7mWoB9Q==
@@ -1039,6 +1046,11 @@
resolved "https://registry.yarnpkg.com/@types/json-schema/-/json-schema-7.0.4.tgz#38fd73ddfd9b55abb1e1b2ed578cb55bd7b7d339"
integrity sha512-8+KAKzEvSUdeo+kmqnKrqgeE+LcA0tjYWFY7RPProVYwnqDjukzO+3b6dLD56rYX5TdWejnEOLJYOIeh4CXKuA==
+"@types/json5@^0.0.29":
+ version "0.0.29"
+ resolved "https://registry.yarnpkg.com/@types/json5/-/json5-0.0.29.tgz#ee28707ae94e11d2b827bcbe5270bcea7f3e71ee"
+ integrity sha1-7ihweulOEdK4J7y+UnC86n8+ce4=
+
"@types/lodash@^4.14.149":
version "4.14.149"
resolved "https://registry.yarnpkg.com/@types/lodash/-/lodash-4.14.149.tgz#1342d63d948c6062838fbf961012f74d4e638440"
@@ -1595,13 +1607,13 @@ argparse@^1.0.7:
dependencies:
sprintf-js "~1.0.2"
-aria-query@^3.0.0:
- version "3.0.0"
- resolved "https://registry.yarnpkg.com/aria-query/-/aria-query-3.0.0.tgz#65b3fcc1ca1155a8c9ae64d6eee297f15d5133cc"
- integrity sha1-ZbP8wcoRVajJrmTW7uKX8V1RM8w=
+aria-query@^4.2.2:
+ version "4.2.2"
+ resolved "https://registry.yarnpkg.com/aria-query/-/aria-query-4.2.2.tgz#0d2ca6c9aceb56b8977e9fed6aed7e15bbd2f83b"
+ integrity sha512-o/HelwhuKpTj/frsOsbNLNgnNGVIFsVP/SW2BSF14gVl7kAfMOJ6/8wUAUvG1R1NHKrfG+2sHZTu0yauT1qBrA==
dependencies:
- ast-types-flow "0.0.7"
- commander "^2.11.0"
+ "@babel/runtime" "^7.10.2"
+ "@babel/runtime-corejs3" "^7.10.2"
arr-diff@^4.0.0:
version "4.0.0"
@@ -1628,7 +1640,7 @@ array-flatten@^2.1.0:
resolved "https://registry.yarnpkg.com/array-flatten/-/array-flatten-2.1.2.tgz#24ef80a28c1a893617e2149b0c6d0d788293b099"
integrity sha512-hNfzcOV8W4NdualtqBFPyVO+54DSJuZGY9qT4pRroB6S9e3iiido2ISIC5h9R2sPJ8H3FHCIiEnsv1lPXO3KtQ==
-array-includes@^3.0.3, array-includes@^3.1.1:
+array-includes@^3.1.1:
version "3.1.1"
resolved "https://registry.yarnpkg.com/array-includes/-/array-includes-3.1.1.tgz#cdd67e6852bdf9c1215460786732255ed2459348"
integrity sha512-c2VXaCHl7zPsvpkFsw4nxvFie4fh1ur9bpcgsVkIjqn0H/Xwdg+7fv3n2r/isyS8EBj5b06M9kHyZuIr4El6WQ==
@@ -1654,7 +1666,7 @@ array-unique@^0.3.2:
resolved "https://registry.yarnpkg.com/array-unique/-/array-unique-0.3.2.tgz#a894b75d4bc4f6cd679ef3244a9fd8f46ae2d428"
integrity sha1-qJS3XUvE9s1nnvMkSp/Y9Gri1Cg=
-array.prototype.flat@^1.2.1:
+array.prototype.flat@^1.2.3:
version "1.2.3"
resolved "https://registry.yarnpkg.com/array.prototype.flat/-/array.prototype.flat-1.2.3.tgz#0de82b426b0318dbfdb940089e38b043d37f6c7b"
integrity sha512-gBlRZV0VSmfPIeWfuuy56XZMvbVfbEUnOXUvt3F/eUUUSyzlgLxhEX4YAEpxNAogRGehPSnfXyPtYyKAhkzQhQ==
@@ -1662,6 +1674,15 @@ array.prototype.flat@^1.2.1:
define-properties "^1.1.3"
es-abstract "^1.17.0-next.1"
+array.prototype.flatmap@^1.2.3:
+ version "1.2.3"
+ resolved "https://registry.yarnpkg.com/array.prototype.flatmap/-/array.prototype.flatmap-1.2.3.tgz#1c13f84a178566042dd63de4414440db9222e443"
+ integrity sha512-OOEk+lkePcg+ODXIpvuU9PAryCikCJyo7GlDG1upleEpQRx6mzL9puEBkozQ5iAx20KV0l3DbyQwqciJtqe5Pg==
+ dependencies:
+ define-properties "^1.1.3"
+ es-abstract "^1.17.0-next.1"
+ function-bind "^1.1.1"
+
asn1.js@^4.0.0:
version "4.10.1"
resolved "https://registry.yarnpkg.com/asn1.js/-/asn1.js-4.10.1.tgz#b9c2bf5805f1e64aadeed6df3a2bfafb5a73f5a0"
@@ -1684,7 +1705,7 @@ assign-symbols@^1.0.0:
resolved "https://registry.yarnpkg.com/assign-symbols/-/assign-symbols-1.0.0.tgz#59667f41fadd4f20ccbc2bb96b8d4f7f78ec0367"
integrity sha1-WWZ/QfrdTyDMvCu5a41Pf3jsA2c=
-ast-types-flow@0.0.7, ast-types-flow@^0.0.7:
+ast-types-flow@^0.0.7:
version "0.0.7"
resolved "https://registry.yarnpkg.com/ast-types-flow/-/ast-types-flow-0.0.7.tgz#f70b735c6bca1a5c9c22d982c3e39e7feba3bdad"
integrity sha1-9wtzXGvKGlycItmCw+Oef+ujva0=
@@ -1738,10 +1759,15 @@ autoprefixer@^6.3.1:
postcss "^5.2.16"
postcss-value-parser "^3.2.3"
-axobject-query@^2.0.2:
- version "2.1.2"
- resolved "https://registry.yarnpkg.com/axobject-query/-/axobject-query-2.1.2.tgz#2bdffc0371e643e5f03ba99065d5179b9ca79799"
- integrity sha512-ICt34ZmrVt8UQnvPl6TVyDTkmhXmAyAT4Jh5ugfGUX4MOrZ+U/ZY6/sdylRw3qGNr9Ub5AJsaHeDMzNLehRdOQ==
+axe-core@^3.5.4:
+ version "3.5.5"
+ resolved "https://registry.yarnpkg.com/axe-core/-/axe-core-3.5.5.tgz#84315073b53fa3c0c51676c588d59da09a192227"
+ integrity sha512-5P0QZ6J5xGikH780pghEdbEKijCTrruK9KxtPZCFWUpef0f6GipO+xEZ5GKCb020mmqgbiNO6TcA55CriL784Q==
+
+axobject-query@^2.1.2:
+ version "2.2.0"
+ resolved "https://registry.yarnpkg.com/axobject-query/-/axobject-query-2.2.0.tgz#943d47e10c0b704aa42275e20edf3722648989be"
+ integrity sha512-Td525n+iPOOyUQIeBfcASuG6uJsDOITl7Mds5gFyerkWiX7qhUTdYUBlSgNMyVqtSJqwpt1kXGLdUt6SykLMRA==
babel-loader@^8.0.6, babel-loader@^8.1.0:
version "8.1.0"
@@ -2504,7 +2530,7 @@ colors@~1.1.2:
resolved "https://registry.yarnpkg.com/colors/-/colors-1.1.2.tgz#168a4701756b6a7f51a12ce0c97bfa28c084ed63"
integrity sha1-FopHAXVran9RoSzgyXv6KMCE7WM=
-commander@^2.11.0, commander@^2.19.0, commander@^2.20.0, commander@~2.20.3:
+commander@^2.19.0, commander@^2.20.0:
version "2.20.3"
resolved "https://registry.yarnpkg.com/commander/-/commander-2.20.3.tgz#fd485e84c03eb4881c20722ba48035e8531aeb33"
integrity sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ==
@@ -2932,7 +2958,7 @@ cyclist@^1.0.1:
resolved "https://registry.yarnpkg.com/cyclist/-/cyclist-1.0.1.tgz#596e9698fd0c80e12038c2b82d6eb1b35b6224d9"
integrity sha1-WW6WmP0MgOEgOMK4LW6xs1tiJNk=
-damerau-levenshtein@^1.0.4:
+damerau-levenshtein@^1.0.6:
version "1.0.6"
resolved "https://registry.yarnpkg.com/damerau-levenshtein/-/damerau-levenshtein-1.0.6.tgz#143c1641cb3d85c60c32329e26899adea8701791"
integrity sha512-JVrozIeElnj3QzfUIt8tB8YMluBJom4Vw9qTPpjGYQ9fYlB3D/rb6OordUxf3xeFB35LKWs0xqcO5U6ySvBtug==
@@ -3398,7 +3424,7 @@ elliptic@^6.0.0:
minimalistic-assert "^1.0.0"
minimalistic-crypto-utils "^1.0.0"
-emoji-regex@^7.0.1, emoji-regex@^7.0.2:
+emoji-regex@^7.0.1:
version "7.0.3"
resolved "https://registry.yarnpkg.com/emoji-regex/-/emoji-regex-7.0.3.tgz#933a04052860c85e83c122479c4748a8e4c72156"
integrity sha512-CwBLREIQ7LvYFB0WyRvwhq5N5qPhc6PMjD6bYggFlI5YyDgl+0vxq5VHbMOFqLg7hfWzmu8T5Z1QofhmTIhItA==
@@ -3408,6 +3434,11 @@ emoji-regex@^8.0.0:
resolved "https://registry.yarnpkg.com/emoji-regex/-/emoji-regex-8.0.0.tgz#e818fd69ce5ccfcb404594f842963bf53164cc37"
integrity sha512-MSjYzcWNOA0ewAHpz0MxpYFvwg6yjy1NG3xteoqz644VCo/RPgnr1/GGt+ic3iJTzQ8Eu3TdM14SawnVUmGE6A==
+emoji-regex@^9.0.0:
+ version "9.0.0"
+ resolved "https://registry.yarnpkg.com/emoji-regex/-/emoji-regex-9.0.0.tgz#48a2309cc8a1d2e9d23bc6a67c39b63032e76ea4"
+ integrity sha512-6p1NII1Vm62wni/VR/cUMauVQoxmLVb9csqQlvLz+hO2gk8U2UYDfXHQSUYIBKmZwAKz867IDqG7B+u0mj+M6w==
+
emojis-list@^2.0.0:
version "2.1.0"
resolved "https://registry.yarnpkg.com/emojis-list/-/emojis-list-2.1.0.tgz#4daa4d9db00f9819880c79fa457ae5b09a1fd389"
@@ -3477,7 +3508,24 @@ error-ex@^1.2.0:
dependencies:
is-arrayish "^0.2.1"
-es-abstract@^1.17.0, es-abstract@^1.17.0-next.1, es-abstract@^1.17.2, es-abstract@^1.17.5:
+es-abstract@^1.17.0, es-abstract@^1.17.0-next.1, es-abstract@^1.17.5:
+ version "1.17.6"
+ resolved "https://registry.yarnpkg.com/es-abstract/-/es-abstract-1.17.6.tgz#9142071707857b2cacc7b89ecb670316c3e2d52a"
+ integrity sha512-Fr89bON3WFyUi5EvAeI48QTWX0AyekGgLA8H+c+7fbfCkJwRWRMLd8CQedNEyJuoYYhmtEqY92pgte1FAhBlhw==
+ dependencies:
+ es-to-primitive "^1.2.1"
+ function-bind "^1.1.1"
+ has "^1.0.3"
+ has-symbols "^1.0.1"
+ is-callable "^1.2.0"
+ is-regex "^1.1.0"
+ object-inspect "^1.7.0"
+ object-keys "^1.1.1"
+ object.assign "^4.1.0"
+ string.prototype.trimend "^1.0.1"
+ string.prototype.trimstart "^1.0.1"
+
+es-abstract@^1.17.2:
version "1.17.5"
resolved "https://registry.yarnpkg.com/es-abstract/-/es-abstract-1.17.5.tgz#d8c9d1d66c8981fb9200e2251d799eee92774ae9"
integrity sha512-BR9auzDbySxOcfog0tLECW8l28eRGpDpU3Dm3Hp4q/N+VtLTmyj4EUN088XZWQDW/hzj6sYRDXeOFsaAODKvpg==
@@ -3528,14 +3576,14 @@ escape-string-regexp@^2.0.0:
resolved "https://registry.yarnpkg.com/escape-string-regexp/-/escape-string-regexp-2.0.0.tgz#a30304e99daa32e23b2fd20f51babd07cffca344"
integrity sha512-UpzcLCXolUWcNu5HtVMHYdXJjArjsF9C0aNnquZYY4uW/Vu0miy5YoWvbV345HauVvcAUnpRuhMMcqTcGOY2+w==
-eslint-config-airbnb-base@^14.1.0:
- version "14.1.0"
- resolved "https://registry.yarnpkg.com/eslint-config-airbnb-base/-/eslint-config-airbnb-base-14.1.0.tgz#2ba4592dd6843258221d9bff2b6831bd77c874e4"
- integrity sha512-+XCcfGyCnbzOnktDVhwsCAx+9DmrzEmuwxyHUJpw+kqBVT744OUBrB09khgFKlK1lshVww6qXGsYPZpavoNjJw==
+eslint-config-airbnb-base@^14.1.0, eslint-config-airbnb-base@^14.2.0:
+ version "14.2.0"
+ resolved "https://registry.yarnpkg.com/eslint-config-airbnb-base/-/eslint-config-airbnb-base-14.2.0.tgz#fe89c24b3f9dc8008c9c0d0d88c28f95ed65e9c4"
+ integrity sha512-Snswd5oC6nJaevs3nZoLSTvGJBvzTfnBqOIArkf3cbyTyq9UD79wOk8s+RiL6bhca0p/eRO6veczhf6A/7Jy8Q==
dependencies:
confusing-browser-globals "^1.0.9"
object.assign "^4.1.0"
- object.entries "^1.1.1"
+ object.entries "^1.1.2"
eslint-config-airbnb-typescript@^7.2.1:
version "7.2.1"
@@ -3547,23 +3595,23 @@ eslint-config-airbnb-typescript@^7.2.1:
eslint-config-airbnb-base "^14.1.0"
eslint-config-airbnb@^18.1.0:
- version "18.1.0"
- resolved "https://registry.yarnpkg.com/eslint-config-airbnb/-/eslint-config-airbnb-18.1.0.tgz#724d7e93dadd2169492ff5363c5aaa779e01257d"
- integrity sha512-kZFuQC/MPnH7KJp6v95xsLBf63G/w7YqdPfQ0MUanxQ7zcKUNG8j+sSY860g3NwCBOa62apw16J6pRN+AOgXzw==
+ version "18.2.0"
+ resolved "https://registry.yarnpkg.com/eslint-config-airbnb/-/eslint-config-airbnb-18.2.0.tgz#8a82168713effce8fc08e10896a63f1235499dcd"
+ integrity sha512-Fz4JIUKkrhO0du2cg5opdyPKQXOI2MvF8KUvN2710nJMT6jaRUpRE2swrJftAjVGL7T1otLM5ieo5RqS1v9Udg==
dependencies:
- eslint-config-airbnb-base "^14.1.0"
+ eslint-config-airbnb-base "^14.2.0"
object.assign "^4.1.0"
- object.entries "^1.1.1"
+ object.entries "^1.1.2"
-eslint-import-resolver-node@^0.3.2:
- version "0.3.3"
- resolved "https://registry.yarnpkg.com/eslint-import-resolver-node/-/eslint-import-resolver-node-0.3.3.tgz#dbaa52b6b2816b50bc6711af75422de808e98404"
- integrity sha512-b8crLDo0M5RSe5YG8Pu2DYBj71tSB6OvXkfzwbJU2w7y8P4/yo0MyF8jU26IEuEuHF2K5/gcAJE3LhQGqBBbVg==
+eslint-import-resolver-node@^0.3.3:
+ version "0.3.4"
+ resolved "https://registry.yarnpkg.com/eslint-import-resolver-node/-/eslint-import-resolver-node-0.3.4.tgz#85ffa81942c25012d8231096ddf679c03042c717"
+ integrity sha512-ogtf+5AB/O+nM6DIeBUNr2fuT7ot9Qg/1harBfBtaP13ekEWFQEEMP94BCB7zaNW3gyY+8SHYF00rnqYwXKWOA==
dependencies:
debug "^2.6.9"
resolve "^1.13.1"
-eslint-module-utils@^2.4.1:
+eslint-module-utils@^2.6.0:
version "2.6.0"
resolved "https://registry.yarnpkg.com/eslint-module-utils/-/eslint-module-utils-2.6.0.tgz#579ebd094f56af7797d19c9866c9c9486629bfa6"
integrity sha512-6j9xxegbqe8/kZY8cYpcp0xhbK0EgJlg3g9mib3/miLaExuuwc3n5UEfSnU6hWMbT0FAYVvDbL9RrRgpUeQIvA==
@@ -3572,37 +3620,40 @@ eslint-module-utils@^2.4.1:
pkg-dir "^2.0.0"
eslint-plugin-import@^2.20.2:
- version "2.20.2"
- resolved "https://registry.yarnpkg.com/eslint-plugin-import/-/eslint-plugin-import-2.20.2.tgz#91fc3807ce08be4837141272c8b99073906e588d"
- integrity sha512-FObidqpXrR8OnCh4iNsxy+WACztJLXAHBO5hK79T1Hc77PgQZkyDGA5Ag9xAvRpglvLNxhH/zSmZ70/pZ31dHg==
+ version "2.22.0"
+ resolved "https://registry.yarnpkg.com/eslint-plugin-import/-/eslint-plugin-import-2.22.0.tgz#92f7736fe1fde3e2de77623c838dd992ff5ffb7e"
+ integrity sha512-66Fpf1Ln6aIS5Gr/55ts19eUuoDhAbZgnr6UxK5hbDx6l/QgQgx61AePq+BV4PP2uXQFClgMVzep5zZ94qqsxg==
dependencies:
- array-includes "^3.0.3"
- array.prototype.flat "^1.2.1"
+ array-includes "^3.1.1"
+ array.prototype.flat "^1.2.3"
contains-path "^0.1.0"
debug "^2.6.9"
doctrine "1.5.0"
- eslint-import-resolver-node "^0.3.2"
- eslint-module-utils "^2.4.1"
+ eslint-import-resolver-node "^0.3.3"
+ eslint-module-utils "^2.6.0"
has "^1.0.3"
minimatch "^3.0.4"
- object.values "^1.1.0"
+ object.values "^1.1.1"
read-pkg-up "^2.0.0"
- resolve "^1.12.0"
+ resolve "^1.17.0"
+ tsconfig-paths "^3.9.0"
-eslint-plugin-jsx-a11y@^6.2.3:
- version "6.2.3"
- resolved "https://registry.yarnpkg.com/eslint-plugin-jsx-a11y/-/eslint-plugin-jsx-a11y-6.2.3.tgz#b872a09d5de51af70a97db1eea7dc933043708aa"
- integrity sha512-CawzfGt9w83tyuVekn0GDPU9ytYtxyxyFZ3aSWROmnRRFQFT2BiPJd7jvRdzNDi6oLWaS2asMeYSNMjWTV4eNg==
+eslint-plugin-jsx-a11y@^6.3.0:
+ version "6.3.1"
+ resolved "https://registry.yarnpkg.com/eslint-plugin-jsx-a11y/-/eslint-plugin-jsx-a11y-6.3.1.tgz#99ef7e97f567cc6a5b8dd5ab95a94a67058a2660"
+ integrity sha512-i1S+P+c3HOlBJzMFORRbC58tHa65Kbo8b52/TwCwSKLohwvpfT5rm2GjGWzOHTEuq4xxf2aRlHHTtmExDQOP+g==
dependencies:
- "@babel/runtime" "^7.4.5"
- aria-query "^3.0.0"
- array-includes "^3.0.3"
+ "@babel/runtime" "^7.10.2"
+ aria-query "^4.2.2"
+ array-includes "^3.1.1"
ast-types-flow "^0.0.7"
- axobject-query "^2.0.2"
- damerau-levenshtein "^1.0.4"
- emoji-regex "^7.0.2"
+ axe-core "^3.5.4"
+ axobject-query "^2.1.2"
+ damerau-levenshtein "^1.0.6"
+ emoji-regex "^9.0.0"
has "^1.0.3"
- jsx-ast-utils "^2.2.1"
+ jsx-ast-utils "^2.4.1"
+ language-tags "^1.0.5"
eslint-plugin-react-hooks@^3.0.0:
version "3.0.0"
@@ -3610,22 +3661,21 @@ eslint-plugin-react-hooks@^3.0.0:
integrity sha512-EjxTHxjLKIBWFgDJdhKKzLh5q+vjTFrqNZX36uIxWS4OfyXe5DawqPj3U5qeJ1ngLwatjzQnmR0Lz0J0YH3kxw==
eslint-plugin-react@^7.19.0:
- version "7.19.0"
- resolved "https://registry.yarnpkg.com/eslint-plugin-react/-/eslint-plugin-react-7.19.0.tgz#6d08f9673628aa69c5559d33489e855d83551666"
- integrity sha512-SPT8j72CGuAP+JFbT0sJHOB80TX/pu44gQ4vXH/cq+hQTiY2PuZ6IHkqXJV6x1b28GDdo1lbInjKUrrdUf0LOQ==
+ version "7.20.3"
+ resolved "https://registry.yarnpkg.com/eslint-plugin-react/-/eslint-plugin-react-7.20.3.tgz#0590525e7eb83890ce71f73c2cf836284ad8c2f1"
+ integrity sha512-txbo090buDeyV0ugF3YMWrzLIUqpYTsWSDZV9xLSmExE1P/Kmgg9++PD931r+KEWS66O1c9R4srLVVHmeHpoAg==
dependencies:
array-includes "^3.1.1"
+ array.prototype.flatmap "^1.2.3"
doctrine "^2.1.0"
has "^1.0.3"
- jsx-ast-utils "^2.2.3"
- object.entries "^1.1.1"
+ jsx-ast-utils "^2.4.1"
+ object.entries "^1.1.2"
object.fromentries "^2.0.2"
object.values "^1.1.1"
prop-types "^15.7.2"
- resolve "^1.15.1"
- semver "^6.3.0"
+ resolve "^1.17.0"
string.prototype.matchall "^4.0.2"
- xregexp "^4.3.0"
eslint-scope@^4.0.3:
version "4.0.3"
@@ -4394,11 +4444,16 @@ got@^9.6.0:
to-readable-stream "^1.0.0"
url-parse-lax "^3.0.0"
-graceful-fs@^4.1.11, graceful-fs@^4.1.15, graceful-fs@^4.1.2, graceful-fs@^4.1.6, graceful-fs@^4.1.9, graceful-fs@^4.2.0, graceful-fs@^4.2.2:
+graceful-fs@^4.1.11, graceful-fs@^4.1.15, graceful-fs@^4.1.9, graceful-fs@^4.2.2:
version "4.2.3"
resolved "https://registry.yarnpkg.com/graceful-fs/-/graceful-fs-4.2.3.tgz#4a12ff1b60376ef09862c2093edd908328be8423"
integrity sha512-a30VEBm4PEdx1dRB7MFK7BejejvCvBronbLjht+sHuGYj8PHs7M/5Z+rt5lw551vZ7yfTCj4Vuyy3mSJytDWRQ==
+graceful-fs@^4.1.2, graceful-fs@^4.1.6, graceful-fs@^4.2.0:
+ version "4.2.4"
+ resolved "https://registry.yarnpkg.com/graceful-fs/-/graceful-fs-4.2.4.tgz#2256bde14d3632958c465ebc96dc467ca07a29fb"
+ integrity sha512-WjKPNJF79dtJAVniUlGGWHYGz2jWxT6VhN/4m1NdkbZ2nOsEF+cI1Edgql5zCRhs/VsQYRvrXctxktVXZUkixw==
+
handle-thing@^2.0.0:
version "2.0.1"
resolved "https://registry.yarnpkg.com/handle-thing/-/handle-thing-2.0.1.tgz#857f79ce359580c340d43081cc648970d0bb234e"
@@ -4508,9 +4563,9 @@ he@^1.2.0:
integrity sha512-F/1DnUGPopORZi0ni+CvrCgHQ5FyEAHRLSApuYWMmrbSwoN2Mn/7k+Gl38gJnR7yyDZk6WLXwiGod1JOWNDKGw==
highlight.js@^10.0.0:
- version "10.0.3"
- resolved "https://registry.yarnpkg.com/highlight.js/-/highlight.js-10.0.3.tgz#5effcc58420f113f279a0badb8ac50c4be06e63b"
- integrity sha512-9FG7SSzv9yOY5CGGxfI6NDm7xLYtMOjKtPBxw7Zff3t5UcRcUNTGEeS8lNjhceL34KeetLMoGMFTGoaa83HwyQ==
+ version "10.1.1"
+ resolved "https://registry.yarnpkg.com/highlight.js/-/highlight.js-10.1.1.tgz#691a2148a8d922bf12e52a294566a0d993b94c57"
+ integrity sha512-b4L09127uVa+9vkMgPpdUQP78ickGbHEQTWeBrQFTJZ4/n2aihWOGS0ZoUqAwjVmfjhq/C76HRzkqwZhK4sBbg==
hmac-drbg@^1.0.0:
version "1.0.1"
@@ -4868,11 +4923,16 @@ internal-slot@^1.0.2:
has "^1.0.3"
side-channel "^1.0.2"
-interpret@1.2.0, interpret@^1.0.0:
+interpret@1.2.0:
version "1.2.0"
resolved "https://registry.yarnpkg.com/interpret/-/interpret-1.2.0.tgz#d5061a6224be58e8083985f5014d844359576296"
integrity sha512-mT34yGKMNceBQUoVn7iCDKDntA7SC6gycMAWzGx1z/CMCTV7b2AAtXlo3nRyHZ1FelRkQbQjprHSYGwzLtkVbw==
+interpret@^1.0.0:
+ version "1.4.0"
+ resolved "https://registry.yarnpkg.com/interpret/-/interpret-1.4.0.tgz#665ab8bc4da27a774a40584e812e3e0fa45b1a1e"
+ integrity sha512-agE4QfB2Lkp9uICn7BAqoscw4SZP9kTE2hxiFI3jBPmXJfdqiahTbUuKGsMoN2GtqL9AxhYioAcVvgsb1HvRbA==
+
invariant@^2.2.2, invariant@^2.2.4:
version "2.2.4"
resolved "https://registry.yarnpkg.com/invariant/-/invariant-2.2.4.tgz#610f3c92c9359ce1db616e538008d23ff35158e6"
@@ -4946,10 +5006,10 @@ is-buffer@^1.1.5:
resolved "https://registry.yarnpkg.com/is-buffer/-/is-buffer-1.1.6.tgz#efaa2ea9daa0d7ab2ea13a97b2b8ad51fefbe8be"
integrity sha512-NcdALwpXkTm5Zvvbk7owOUSvVvBKDgKP5/ewfXEznmQFfs4ZRmanOeKBTjRVjka3QFoN6XJ+9F3USqfHqTaU5w==
-is-callable@^1.1.4, is-callable@^1.1.5:
- version "1.1.5"
- resolved "https://registry.yarnpkg.com/is-callable/-/is-callable-1.1.5.tgz#f7e46b596890456db74e7f6e976cb3273d06faab"
- integrity sha512-ESKv5sMCJB2jnHTWZ3O5itG+O128Hsus4K4Qh1h2/cgn2vbgnLSVqfV46AeJA9D5EeeLa9w81KUXMtn34zhX+Q==
+is-callable@^1.1.4, is-callable@^1.1.5, is-callable@^1.2.0:
+ version "1.2.0"
+ resolved "https://registry.yarnpkg.com/is-callable/-/is-callable-1.2.0.tgz#83336560b54a38e35e3a2df7afd0454d691468bb"
+ integrity sha512-pyVD9AaGLxtg6srb2Ng6ynWJqkHU9bEM087AKck0w8QwDarTfNcpIYoU8x8Hv2Icm8u6kFJM18Dag8lyqGkviw==
is-ci@^2.0.0:
version "2.0.0"
@@ -5109,13 +5169,20 @@ is-promise@^2.1.0:
resolved "https://registry.yarnpkg.com/is-promise/-/is-promise-2.1.0.tgz#79a2a9ece7f096e80f36d2b2f3bc16c1ff4bf3fa"
integrity sha1-eaKp7OfwlugPNtKy87wWwf9L8/o=
-is-regex@^1.0.4, is-regex@^1.0.5:
+is-regex@^1.0.4:
version "1.0.5"
resolved "https://registry.yarnpkg.com/is-regex/-/is-regex-1.0.5.tgz#39d589a358bf18967f726967120b8fc1aed74eae"
integrity sha512-vlKW17SNq44owv5AQR3Cq0bQPEb8+kF3UKZ2fiZNOWtztYE5i0CzCZxFDwO58qAOWtxdBRVO/V5Qin1wjCqFYQ==
dependencies:
has "^1.0.3"
+is-regex@^1.0.5, is-regex@^1.1.0:
+ version "1.1.0"
+ resolved "https://registry.yarnpkg.com/is-regex/-/is-regex-1.1.0.tgz#ece38e389e490df0dc21caea2bd596f987f767ff"
+ integrity sha512-iI97M8KTWID2la5uYXlkbSDQIg4F6o1sYboZKKTDpnDQMLtUL86zxhgDet3Q2SriaYsyGqZ6Mn2SjbRKeLHdqw==
+ dependencies:
+ has-symbols "^1.0.1"
+
is-stream@^1.1.0:
version "1.1.0"
resolved "https://registry.yarnpkg.com/is-stream/-/is-stream-1.1.0.tgz#12d4a3dd4e68e0b79ceb8dbc84173ae80d91ca44"
@@ -5318,12 +5385,12 @@ jsonfile@^6.0.1:
optionalDependencies:
graceful-fs "^4.1.6"
-jsx-ast-utils@^2.2.1, jsx-ast-utils@^2.2.3:
- version "2.2.3"
- resolved "https://registry.yarnpkg.com/jsx-ast-utils/-/jsx-ast-utils-2.2.3.tgz#8a9364e402448a3ce7f14d357738310d9248054f"
- integrity sha512-EdIHFMm+1BPynpKOpdPqiOsvnIrInRGJD7bzPZdPkjitQEqpdpUuFpq4T0npZFKTiB3RhWFdGN+oqOJIdhDhQA==
+jsx-ast-utils@^2.4.1:
+ version "2.4.1"
+ resolved "https://registry.yarnpkg.com/jsx-ast-utils/-/jsx-ast-utils-2.4.1.tgz#1114a4c1209481db06c690c2b4f488cc665f657e"
+ integrity sha512-z1xSldJ6imESSzOjd3NNkieVJKRlKYSOtMG8SFyCj2FIrvSaSuli/WjpBkEzCBoR9bYYYFgqJw61Xhu7Lcgk+w==
dependencies:
- array-includes "^3.0.3"
+ array-includes "^3.1.1"
object.assign "^4.1.0"
keyv@^3.0.0:
@@ -5369,6 +5436,18 @@ klaw@^3.0.0:
dependencies:
graceful-fs "^4.1.9"
+language-subtag-registry@~0.3.2:
+ version "0.3.20"
+ resolved "https://registry.yarnpkg.com/language-subtag-registry/-/language-subtag-registry-0.3.20.tgz#a00a37121894f224f763268e431c55556b0c0755"
+ integrity sha512-KPMwROklF4tEx283Xw0pNKtfTj1gZ4UByp4EsIFWLgBavJltF4TiYPc39k06zSTsLzxTVXXDSpbwaQXaFB4Qeg==
+
+language-tags@^1.0.5:
+ version "1.0.5"
+ resolved "https://registry.yarnpkg.com/language-tags/-/language-tags-1.0.5.tgz#d321dbc4da30ba8bf3024e040fa5c14661f9193a"
+ integrity sha1-0yHbxNowuovzAk4ED6XBRmH5GTo=
+ dependencies:
+ language-subtag-registry "~0.3.2"
+
latest-version@^5.0.0:
version "5.1.0"
resolved "https://registry.yarnpkg.com/latest-version/-/latest-version-5.1.0.tgz#119dfe908fe38d15dfa43ecd13fa12ec8832face"
@@ -6087,9 +6166,9 @@ object-copy@^0.1.0:
kind-of "^3.0.3"
object-inspect@^1.7.0:
- version "1.7.0"
- resolved "https://registry.yarnpkg.com/object-inspect/-/object-inspect-1.7.0.tgz#f4f6bd181ad77f006b5ece60bd0b6f398ff74a67"
- integrity sha512-a7pEHdh1xKIAgTySUGgLMx/xwDZskN1Ud6egYYN3EdRW4ZMPNEDUTF+hwy2LUC+Bl+SyLXANnwz/jyh/qutKUw==
+ version "1.8.0"
+ resolved "https://registry.yarnpkg.com/object-inspect/-/object-inspect-1.8.0.tgz#df807e5ecf53a609cc6bfe93eac3cc7be5b3a9d0"
+ integrity sha512-jLdtEOB112fORuypAyl/50VRVIBIdVQOSUUGQHzJ4xBSbit81zRarz7GThkEFZy1RceYrWYcPcBFPQwHyAc1gA==
object-is@^1.0.1:
version "1.0.2"
@@ -6118,14 +6197,13 @@ object.assign@^4.1.0:
has-symbols "^1.0.0"
object-keys "^1.0.11"
-object.entries@^1.1.1:
- version "1.1.1"
- resolved "https://registry.yarnpkg.com/object.entries/-/object.entries-1.1.1.tgz#ee1cf04153de02bb093fec33683900f57ce5399b"
- integrity sha512-ilqR7BgdyZetJutmDPfXCDffGa0/Yzl2ivVNpbx/g4UeWrCdRnFDUBrKJGLhGieRHDATnyZXWBeCb29k9CJysQ==
+object.entries@^1.1.2:
+ version "1.1.2"
+ resolved "https://registry.yarnpkg.com/object.entries/-/object.entries-1.1.2.tgz#bc73f00acb6b6bb16c203434b10f9a7e797d3add"
+ integrity sha512-BQdB9qKmb/HyNdMNWVr7O3+z5MUIx3aiegEIJqjMBbBf0YT9RRxTJSim4mzFqtyr7PDAHigq0N9dO0m0tRakQA==
dependencies:
define-properties "^1.1.3"
- es-abstract "^1.17.0-next.1"
- function-bind "^1.1.1"
+ es-abstract "^1.17.5"
has "^1.0.3"
object.fromentries@^2.0.2:
@@ -7445,14 +7523,14 @@ resolve-url@^0.2.1:
resolved "https://registry.yarnpkg.com/resolve-url/-/resolve-url-0.2.1.tgz#2c637fe77c893afd2a663fe21aa9080068e2052a"
integrity sha1-LGN/53yJOv0qZj/iGqkIAGjiBSo=
-resolve@^1.1.6, resolve@^1.12.0, resolve@^1.13.1:
+resolve@^1.1.6, resolve@^1.10.0, resolve@^1.13.1, resolve@^1.17.0:
version "1.17.0"
resolved "https://registry.yarnpkg.com/resolve/-/resolve-1.17.0.tgz#b25941b54968231cc2d1bb76a79cb7f2c0bf8444"
integrity sha512-ic+7JYiV8Vi2yzQGFWOkiZD5Z9z7O2Zhm9XMaTxdJExKasieFCr+yXZ/WmXsckHiKl12ar0y6XiXDx3m4RHn1w==
dependencies:
path-parse "^1.0.6"
-resolve@^1.10.0, resolve@^1.15.1, resolve@^1.3.2, resolve@^1.8.1:
+resolve@^1.3.2, resolve@^1.8.1:
version "1.15.1"
resolved "https://registry.yarnpkg.com/resolve/-/resolve-1.15.1.tgz#27bdcdeffeaf2d6244b95bb0f9f4b4653451f3e8"
integrity sha512-84oo6ZTtoTUpjgNEr5SJyzQhzL72gaRodsSfyxC/AXRvwu0Yse9H8eF9IpGo7b8YetZhlI6v7ZQ6bKBFV/6S7w==
@@ -7931,22 +8009,22 @@ source-map@^0.7.3:
integrity sha512-CkCj6giN3S+n9qrYiBTX5gystlENnRW5jZeNLHpe6aue+SrHcG5VYwujhW9s4dY31mEGsxBDrHR6oI69fTXsaQ==
spdx-correct@^3.0.0:
- version "3.1.0"
- resolved "https://registry.yarnpkg.com/spdx-correct/-/spdx-correct-3.1.0.tgz#fb83e504445268f154b074e218c87c003cd31df4"
- integrity sha512-lr2EZCctC2BNR7j7WzJ2FpDznxky1sjfxvvYEyzxNyb6lZXHODmEoJeFu4JupYlkfha1KZpJyoqiJ7pgA1qq8Q==
+ version "3.1.1"
+ resolved "https://registry.yarnpkg.com/spdx-correct/-/spdx-correct-3.1.1.tgz#dece81ac9c1e6713e5f7d1b6f17d468fa53d89a9"
+ integrity sha512-cOYcUWwhCuHCXi49RhFRCyJEK3iPj1Ziz9DpViV3tbZOwXD49QzIN3MpOLJNxh2qwq2lJJZaKMVw9qNi4jTC0w==
dependencies:
spdx-expression-parse "^3.0.0"
spdx-license-ids "^3.0.0"
spdx-exceptions@^2.1.0:
- version "2.2.0"
- resolved "https://registry.yarnpkg.com/spdx-exceptions/-/spdx-exceptions-2.2.0.tgz#2ea450aee74f2a89bfb94519c07fcd6f41322977"
- integrity sha512-2XQACfElKi9SlVb1CYadKDXvoajPgBVPn/gOQLrTvHdElaVhr7ZEbqJaRnJLVNeaI4cMEAgVCeBMKF6MWRDCRA==
+ version "2.3.0"
+ resolved "https://registry.yarnpkg.com/spdx-exceptions/-/spdx-exceptions-2.3.0.tgz#3f28ce1a77a00372683eade4a433183527a2163d"
+ integrity sha512-/tTrYOC7PPI1nUAgx34hUpqXuyJG+DTHJTnIULG4rDygi4xu/tfgmq1e1cIRwRzwZgo4NLySi+ricLkZkw4i5A==
spdx-expression-parse@^3.0.0:
- version "3.0.0"
- resolved "https://registry.yarnpkg.com/spdx-expression-parse/-/spdx-expression-parse-3.0.0.tgz#99e119b7a5da00e05491c9fa338b7904823b41d0"
- integrity sha512-Yg6D3XpRD4kkOmTpdgbUiEJFKghJH03fiC1OPll5h/0sO6neh2jqRDVHOQ4o/LMea0tgCkbMgea5ip/e+MkWyg==
+ version "3.0.1"
+ resolved "https://registry.yarnpkg.com/spdx-expression-parse/-/spdx-expression-parse-3.0.1.tgz#cf70f50482eefdc98e3ce0a6833e4a53ceeba679"
+ integrity sha512-cbqHunsQWnJNE6KhVSMsMeH5H/L9EpymbzqTQ3uLwNCLZ1Q481oWaofqH7nO6V07xlXwY6PhQdQ2IedWx/ZK4Q==
dependencies:
spdx-exceptions "^2.1.0"
spdx-license-ids "^3.0.0"
@@ -8118,10 +8196,10 @@ string.prototype.matchall@^4.0.2:
regexp.prototype.flags "^1.3.0"
side-channel "^1.0.2"
-string.prototype.trimend@^1.0.0:
- version "1.0.0"
- resolved "https://registry.yarnpkg.com/string.prototype.trimend/-/string.prototype.trimend-1.0.0.tgz#ee497fd29768646d84be2c9b819e292439614373"
- integrity sha512-EEJnGqa/xNfIg05SxiPSqRS7S9qwDhYts1TSLR1BQfYUfPe1stofgGKvwERK9+9yf+PpfBMlpBaCHucXGPQfUA==
+string.prototype.trimend@^1.0.0, string.prototype.trimend@^1.0.1:
+ version "1.0.1"
+ resolved "https://registry.yarnpkg.com/string.prototype.trimend/-/string.prototype.trimend-1.0.1.tgz#85812a6b847ac002270f5808146064c995fb6913"
+ integrity sha512-LRPxFUaTtpqYsTeNKaFOw3R4bxIzWOnbQ837QfBylo8jIxtcbK/A/sMV7Q+OAV/vWo+7s25pOE10KYSjaSO06g==
dependencies:
define-properties "^1.1.3"
es-abstract "^1.17.5"
@@ -8144,10 +8222,10 @@ string.prototype.trimright@^2.1.1:
es-abstract "^1.17.5"
string.prototype.trimend "^1.0.0"
-string.prototype.trimstart@^1.0.0:
- version "1.0.0"
- resolved "https://registry.yarnpkg.com/string.prototype.trimstart/-/string.prototype.trimstart-1.0.0.tgz#afe596a7ce9de905496919406c9734845f01a2f2"
- integrity sha512-iCP8g01NFYiiBOnwG1Xc3WZLyoo+RuBymwIlWncShXDDJYWN6DbnM3odslBJdgCdRlq94B5s63NWAZlcn2CS4w==
+string.prototype.trimstart@^1.0.0, string.prototype.trimstart@^1.0.1:
+ version "1.0.1"
+ resolved "https://registry.yarnpkg.com/string.prototype.trimstart/-/string.prototype.trimstart-1.0.1.tgz#14af6d9f34b053f7cfc89b72f8f2ee14b9039a54"
+ integrity sha512-XxZn+QpvrBI1FOcg6dIpxUPgWCPuNXvMD72aaRaUQv1eD4e/Qy8i/hFTe0BUmD60p/QA6bh1avmuPTfNjqVWRw==
dependencies:
define-properties "^1.1.3"
es-abstract "^1.17.5"
@@ -8471,6 +8549,16 @@ truncate-utf8-bytes@^1.0.0:
dependencies:
utf8-byte-length "^1.0.1"
+tsconfig-paths@^3.9.0:
+ version "3.9.0"
+ resolved "https://registry.yarnpkg.com/tsconfig-paths/-/tsconfig-paths-3.9.0.tgz#098547a6c4448807e8fcb8eae081064ee9a3c90b"
+ integrity sha512-dRcuzokWhajtZWkQsDVKbWyY+jgcLC5sqJhg2PSgf4ZkH2aHPvaOY8YWGhmjb68b5qqTfasSsDO9k7RUiEmZAw==
+ dependencies:
+ "@types/json5" "^0.0.29"
+ json5 "^1.0.1"
+ minimist "^1.2.0"
+ strip-bom "^3.0.0"
+
tslib@^1.10.0, tslib@^1.8.1, tslib@^1.9.0:
version "1.11.1"
resolved "https://registry.yarnpkg.com/tslib/-/tslib-1.11.1.tgz#eb15d128827fbee2841549e171f45ed338ac7e35"
@@ -8530,10 +8618,10 @@ typedarray@^0.0.6:
resolved "https://registry.yarnpkg.com/typedarray/-/typedarray-0.0.6.tgz#867ac74e3864187b1d3d47d996a78ec5c8830777"
integrity sha1-hnrHTjhkGHsdPUfZlqeOxciDB3c=
-typedoc-default-themes@^0.10.1:
- version "0.10.1"
- resolved "https://registry.yarnpkg.com/typedoc-default-themes/-/typedoc-default-themes-0.10.1.tgz#eb27b7d689457c7ec843e47ec0d3e500581296a7"
- integrity sha512-SuqAQI0CkwhqSJ2kaVTgl37cWs733uy9UGUqwtcds8pkFK8oRF4rZmCq+FXTGIb9hIUOu40rf5Kojg0Ha6akeg==
+typedoc-default-themes@^0.10.2:
+ version "0.10.2"
+ resolved "https://registry.yarnpkg.com/typedoc-default-themes/-/typedoc-default-themes-0.10.2.tgz#743380a80afe62c5ef92ca1bd4abe2ac596be4d2"
+ integrity sha512-zo09yRj+xwLFE3hyhJeVHWRSPuKEIAsFK5r2u47KL/HBKqpwdUSanoaz5L34IKiSATFrjG5ywmIu98hPVMfxZg==
dependencies:
lunr "^2.3.8"
@@ -8545,10 +8633,10 @@ typedoc-plugin-external-module-name@^3.1.0:
lodash "^4.1.2"
semver "^7.1.1"
-typedoc@^0.17.6:
- version "0.17.6"
- resolved "https://registry.yarnpkg.com/typedoc/-/typedoc-0.17.6.tgz#cab87a72c10e05429016d659a4c3071a5a3ffb61"
- integrity sha512-pQiYnhG3yJk7939cv2n8uFoTsSgy5Hfiw0dgOQYa9nT9Ya1013dMctQdAXMj8JbNu7KhcauQyq9Zql9D/TziLw==
+typedoc@^0.17.8:
+ version "0.17.8"
+ resolved "https://registry.yarnpkg.com/typedoc/-/typedoc-0.17.8.tgz#96b67e9454aa7853bfc4dc9a55c8a07adfd5478e"
+ integrity sha512-/OyrHCJ8jtzu+QZ+771YaxQ9s4g5Z3XsQE3Ma7q+BL392xxBn4UMvvCdVnqKC2T/dz03/VXSLVKOP3lHmDdc/w==
dependencies:
fs-extra "^8.1.0"
handlebars "^4.7.6"
@@ -8559,7 +8647,7 @@ typedoc@^0.17.6:
minimatch "^3.0.0"
progress "^2.0.3"
shelljs "^0.8.4"
- typedoc-default-themes "^0.10.1"
+ typedoc-default-themes "^0.10.2"
typescript@^3.8.3:
version "3.8.3"
@@ -8572,11 +8660,9 @@ uc.micro@^1.0.1, uc.micro@^1.0.5:
integrity sha512-8Y75pvTYkLJW2hWQHXxoqRgV7qb9B+9vFEtidML+7koHUFapnVJAZ6cKs+Qjz5Aw3aZWHMC6u0wJE3At+nSGwA==
uglify-js@^3.1.4:
- version "3.9.3"
- resolved "https://registry.yarnpkg.com/uglify-js/-/uglify-js-3.9.3.tgz#4a285d1658b8a2ebaef9e51366b3a0f7acd79ec2"
- integrity sha512-r5ImcL6QyzQGVimQoov3aL2ZScywrOgBXGndbWrdehKoSvGe/RmiE5Jpw/v+GvxODt6l2tpBXwA7n+qZVlHBMA==
- dependencies:
- commander "~2.20.3"
+ version "3.10.0"
+ resolved "https://registry.yarnpkg.com/uglify-js/-/uglify-js-3.10.0.tgz#397a7e6e31ce820bfd1cb55b804ee140c587a9e7"
+ integrity sha512-Esj5HG5WAyrLIdYU74Z3JdG2PxdIusvj6IWHMtlyESxc7kcDz7zYlYjpnSokn1UbpV0d/QX9fan7gkCNd/9BQA==
underscore@~1.9.1:
version "1.9.2"
@@ -9113,13 +9199,6 @@ xpipe@*:
resolved "https://registry.yarnpkg.com/xpipe/-/xpipe-1.0.5.tgz#8dd8bf45fc3f7f55f0e054b878f43a62614dafdf"
integrity sha1-jdi/Rfw/f1Xw4FS4ePQ6YmFNr98=
-xregexp@^4.3.0:
- version "4.3.0"
- resolved "https://registry.yarnpkg.com/xregexp/-/xregexp-4.3.0.tgz#7e92e73d9174a99a59743f67a4ce879a04b5ae50"
- integrity sha512-7jXDIFXh5yJ/orPn4SXjuVrWWoi4Cr8jfV1eHv9CixKSbU+jY4mxfrBwAuDvupPNKpMUY+FeIqsVw/JLT9+B8g==
- dependencies:
- "@babel/runtime-corejs3" "^7.8.3"
-
xtend@^4.0.0, xtend@~4.0.1:
version "4.0.2"
resolved "https://registry.yarnpkg.com/xtend/-/xtend-4.0.2.tgz#bb72779f5fa465186b1f438f674fa347fdb5db54"
diff --git a/nix/default.nix b/nix/default.nix
index 5b892f99684c6fbc9350df9a936c175b73a09bdd..0121a1d19f4c87a04e15fa7da4876daede52c45c 100644
--- a/nix/default.nix
+++ b/nix/default.nix
@@ -2,7 +2,7 @@
{ pkgs, stdenv, src ? ../., opam2nix, ocaml_version ? "ocaml-ng.ocamlPackages_4_05.ocaml", plugins ? { } }:
let mk_buildInputs = { opamPackages ? [], nixPackages ? [] } :
- [ pkgs.gnugrep pkgs.gnused pkgs.autoconf pkgs.gnumake pkgs.gcc pkgs.ncurses pkgs.time pkgs.python3 pkgs.perl pkgs.file pkgs.which] ++ nixPackages ++ opam2nix.build {
+ [ pkgs.gnugrep pkgs.gnused pkgs.autoconf pkgs.gnumake pkgs.gcc pkgs.ncurses pkgs.time pkgs.python3 pkgs.perl pkgs.file pkgs.which pkgs.dos2unix] ++ nixPackages ++ opam2nix.build {
specs = opam2nix.toSpecs ([ "ocamlfind" "zarith" "ocamlgraph" "yojson"
{ name = "coq"; constraint = "=8.11.1"; }
{ name = "why3" ; constraint = "=1.3.1"; }
@@ -15,13 +15,20 @@ let mk_buildInputs = { opamPackages ? [], nixPackages ? [] } :
ocamlAttr = ocaml_version;
};
+ # Extends the call to stdenv.mkDerivation with parameters common for all
+ # frama-c derivations
+ mk_deriv = args:
+ stdenv.mkDerivation ({
+ # Disable Nix's GCC hardening
+ hardeningDisable = [ "all" ];
+ } // args);
in
rec {
inherit src mk_buildInputs;
buildInputs = mk_buildInputs {};
installed = main.out;
- main = stdenv.mkDerivation {
+ main = mk_deriv {
name = "frama-c";
inherit src buildInputs;
outputs = [ "out" "build_dir" ];
@@ -63,7 +70,7 @@ rec {
'';
};
- lint = stdenv.mkDerivation {
+ lint = mk_deriv {
name = "frama-c-lint";
inherit src;
buildInputs = (mk_buildInputs { opamPackages = [ { name = "ocp-indent"; constraint = "=1.7.0"; } ];} )
@@ -87,7 +94,7 @@ rec {
'';
};
- tests = stdenv.mkDerivation {
+ tests = mk_deriv {
name = "frama-c-test";
inherit buildInputs;
build_dir = main.build_dir;
@@ -109,7 +116,7 @@ rec {
'';
};
- build-distrib-tarball = stdenv.mkDerivation {
+ build-distrib-tarball = mk_deriv {
name = "frama-c-build-distrib-tarball";
inherit src;
buildInputs = buildInputs ++ [ plugins.headache.installed ];
@@ -132,7 +139,7 @@ rec {
'';
};
- build-from-distrib-tarball = stdenv.mkDerivation {
+ build-from-distrib-tarball = mk_deriv {
name = "frama-c-build-from-distrib-tarball";
inherit buildInputs;
src = build-distrib-tarball.out ;
@@ -150,7 +157,7 @@ rec {
'';
};
- wp-qualif = stdenv.mkDerivation {
+ wp-qualif = mk_deriv {
name = "frama-c-wp-qualif";
buildInputs = mk_buildInputs { opamPackages = [
{ name = "alt-ergo"; constraint = "=2.0.0"; }
@@ -180,7 +187,7 @@ rec {
'';
};
- e-acsl-tests-dev = stdenv.mkDerivation {
+ e-acsl-tests-dev = mk_deriv {
name = "frama-c-e-acsl-tests-dev";
buildInputs = mk_buildInputs { nixPackages = [ pkgs.gmp pkgs.getopt ]; };
build_dir = main.build_dir;
@@ -202,7 +209,7 @@ rec {
'';
};
- internal = stdenv.mkDerivation {
+ internal = mk_deriv {
name = "frama-c-internal";
inherit src;
buildInputs = (mk_buildInputs { opamPackages = [ "xml-light" ]; } ) ++
diff --git a/ptests/ptests.ml b/ptests/ptests.ml
index 6b316854a46960544bb38a7812c206217cb4304b..3202933a25a1a124dc0eda2ae77bae5763a43943 100644
--- a/ptests/ptests.ml
+++ b/ptests/ptests.ml
@@ -819,13 +819,16 @@ let scan_options dir scan_buffer default =
r := (List.assoc name config_options) dir opt !r
with Not_found ->
lock_eprintf "@[unknown configuration option: %s@\n%!@]" name)
- with Scanf.Scan_failure _ ->
+ with
+ | Scanf.Scan_failure _ ->
if str_string_match end_comment s 0
then raise End_of_file
else ()
+ | End_of_file -> (* ignore blank lines. *) ()
in
try
while true do
+ if Scanf.Scanning.end_of_input scan_buffer then raise End_of_file;
Scanf.bscanf scan_buffer "%s@\n" treat_line
done;
assert false
diff --git a/reference-configuration.md b/reference-configuration.md
index 4924e5ebc07ff2fce10e9a8b86ceedf958fdee05..67657200acdd65fd4798d090e3865c5e88fb7d3d 100644
--- a/reference-configuration.md
+++ b/reference-configuration.md
@@ -1,14 +1,15 @@
The following set of packages is known to be a working configuration for
-compiling Frama-C 21 (Scandium), on a machine with gcc <= 9[^gcc-10]
+compiling Frama-C+dev, on a machine with gcc <= 9[^gcc-10]
-- OCaml 4.07.1
-- ocamlfind.1.8.0
-- apron.v0.9.12 (optional)
-- lablgtk.2.18.10 | lablgtk3.3.0.beta6 + lablgtk3-sourceview3.3.0.beta6
-- mlgmpidl.1.2.12 (optional)
+- OCaml 4.08.1
+- alt-ergo.2.0.0 (for wp, optional)
+- apron.v0.9.12 (for eva, optional)
+- lablgtk.2.18.11 | lablgtk3.3.1.1 + lablgtk3-sourceview3.3.1.1
+- mlgmpidl.1.2.12 (for eva, optional)
+- ocamlfind.1.8.1
- ocamlgraph.1.8.8
+- ppx_deriving_yojson.3.5.2 (for mdr, optional)
- why3.1.3.1
-- alt-ergo.2.0.0 (for wp, optional)
- yojson.1.7.0
- zarith.1.9.1
- zmq.5.1.3 (for server, optional)
@@ -16,5 +17,4 @@ compiling Frama-C 21 (Scandium), on a machine with gcc <= 9[^gcc-10]
[^gcc-10]: As mentioned in this [OCaml PR](https://github.com/ocaml/ocaml/issues/9144)
gcc 10 changed its default linking conventions to make them more stringent,
resulting in various linking issues. In particular, only OCaml 4.10 can be
-linked against gcc-10. With respect to the list above, this also means using
-ocamlfind.1.8.1 and the development version of lablgtk (https://github.com/garrigue/lablgtk)
\ No newline at end of file
+linked against gcc-10.
diff --git a/share/Makefile.config.in b/share/Makefile.config.in
index 5b485c09b90a8ca699170b6a3e6f649d48946a9a..653d91fad5e4696a2cb7398993aad983048684d5 100644
--- a/share/Makefile.config.in
+++ b/share/Makefile.config.in
@@ -138,6 +138,9 @@ HAS_DOT ?=@HAS_DOT@
HEADACHE ?= headache -c $(FRAMAC_SRC)/headers/headache_config.txt
+UNIX2DOS ?= @UNIX2DOS@
+HAS_UNIX2DOS ?= @HAS_UNIX2DOS@
+
###########################
# Miscellaneous variables #
###########################
diff --git a/src/kernel_internals/parsing/logic_preprocess.mll b/src/kernel_internals/parsing/logic_preprocess.mll
index ff9d1acb52dd5ff53b0f2045c5f11ade20418656..34ea01b4d6bda1c8a16eb82d54425fc1b82b90ef 100644
--- a/src/kernel_internals/parsing/logic_preprocess.mll
+++ b/src/kernel_internals/parsing/logic_preprocess.mll
@@ -94,13 +94,14 @@
let content = Buffer.create 80 in
let rec ignore_content () =
let s = input_line file in
- if s <> annot_beg then ignore_content ()
+ if not (Extlib.string_prefix annot_beg s) then ignore_content ()
in
let rec get_annot first =
let s = input_line file in
- if s = annot_end then false, Buffer.contents content
- else if s = annot_end_nl then true, Buffer.contents content
- else if s = annot_end_comment then begin
+ if Extlib.string_prefix annot_end s then false, Buffer.contents content
+ else if Extlib.string_prefix annot_end_nl s then
+ true, Buffer.contents content
+ else if Extlib.string_prefix annot_end_comment s then begin
Buffer.add_char content '\n';
false, Buffer.contents content
end else begin
diff --git a/src/kernel_internals/runtime/frama_c_config.ml.in b/src/kernel_internals/runtime/frama_c_config.ml.in
index f9488a16dcccdbdd2a8d3dc5d70d52fdcefc0640..6b0e200a724380edfba96d88e2aaa62243da89fb 100644
--- a/src/kernel_internals/runtime/frama_c_config.ml.in
+++ b/src/kernel_internals/runtime/frama_c_config.ml.in
@@ -53,7 +53,7 @@ let options = Arg.([
"-scripts",
Unit (fun _ -> Format.printf "%s%!"
- (Filename.concat Fc_config.datadir "analyis-scripts"); exit 0),
+ (Filename.concat Fc_config.datadir "analysis-scripts"); exit 0),
" Print the path of Frama-C analysis-scripts directory";
"-print-libpath",
diff --git a/src/kernel_internals/typing/cabs2cil.ml b/src/kernel_internals/typing/cabs2cil.ml
index 2b0157f69b5bb35fd22301b642da63030e968430..17cf66913b9a127047fe7e66bbaf98ad4e871dfb 100644
--- a/src/kernel_internals/typing/cabs2cil.ml
+++ b/src/kernel_internals/typing/cabs2cil.ml
@@ -448,6 +448,19 @@ let process_pack_pragma name args =
current_packing_pragma:= new_pragma; None
end else
Some (Attr (name, args))
+ | ACons ("push",[]) :: args (* unknown push directive *) ->
+ Kernel.warning ~current:true
+ "Unsupported argument for pragma pack push directive: `%a'."
+ Format.(
+ pp_print_list
+ ~pp_sep:(fun fmt ()->pp_print_string fmt ", ")
+ Cil_printer.pp_attrparam)
+ args;
+ (* We don't change the current packing directive, but
+ nevertheless push it on the stack, to avoid a mismatched
+ pop somewhere later. *)
+ Stack.push !current_packing_pragma packing_pragma_stack;
+ None
| [ACons ("pop",[])] (* #pragma pack(pop) *) ->
begin try
current_packing_pragma := Stack.pop packing_pragma_stack;
diff --git a/src/kernel_services/abstract_interp/bottom.mli b/src/kernel_services/abstract_interp/bottom.mli
index 799ccedfc3f67f9507b9bcb5b89893eeb0bb109a..0af283e70bf755cd874fc5ea3bc51725fd8007d6 100644
--- a/src/kernel_services/abstract_interp/bottom.mli
+++ b/src/kernel_services/abstract_interp/bottom.mli
@@ -42,7 +42,7 @@ val non_bottom: 'a or_bottom -> 'a
val equal: ('a -> 'a -> bool) -> 'a or_bottom -> 'a or_bottom -> bool
val compare: ('a -> 'a -> int) -> 'a or_bottom -> 'a or_bottom -> int
-val is_included: ('a -> 'a -> bool) -> 'a or_bottom -> 'a or_bottom -> bool
+val is_included: ('a -> 'b -> bool) -> 'a or_bottom -> 'b or_bottom -> bool
val join: ('a -> 'a -> 'a) -> 'a or_bottom -> 'a or_bottom -> 'a or_bottom
val join_list: ('a -> 'a -> 'a) -> 'a or_bottom list -> 'a or_bottom
val narrow: ('a -> 'a -> 'a or_bottom) -> 'a or_bottom -> 'a or_bottom -> 'a or_bottom
diff --git a/src/kernel_services/abstract_interp/locations.ml b/src/kernel_services/abstract_interp/locations.ml
index 6af4807ad9b794215796de279d6fd12c749bf790..64b75c8765fc4219d2c831d6d1f165cd59197ca2 100644
--- a/src/kernel_services/abstract_interp/locations.ml
+++ b/src/kernel_services/abstract_interp/locations.ml
@@ -286,41 +286,6 @@ module Location_Bytes = struct
| Base.Variable { Base.weak } -> not weak
with Not_found -> false
- let iter_on_strings =
- let z = "\000" in
- fun ~skip f l ->
- match l with
- | Top _ ->
- assert false
- | Map m ->
- M.iter
- (fun base offs ->
- match skip with
- Some base_to_skip when Base.equal base base_to_skip -> ()
- | _ ->
- match base with
- Base.String (_, strid) ->
- let str =
- match strid with
- | Base.CSString s -> s
- | Base.CSWstring _ ->
- failwith "Unimplemented: wide strings"
- in
- let strz = str ^ z in
- let len = String.length str in
- let range =
- Ival.inject_range
- (Some Int.zero)
- (Some (Int.of_int len))
- in
- let roffs = Ival.narrow range offs in
- Ival.fold_int
- (fun i () -> f base strz (Int.to_int i) len)
- roffs
- ()
- | _ -> ())
- m
-
let topify_merge_origin v =
topify_with_origin_kind Origin.K_Merge v
diff --git a/src/kernel_services/abstract_interp/locations.mli b/src/kernel_services/abstract_interp/locations.mli
index f96d8f6bccf067d275003dec375f9f13a8bb9d5d..b8de6dce344930a6d04a3a1b97088f0a966d7976 100644
--- a/src/kernel_services/abstract_interp/locations.mli
+++ b/src/kernel_services/abstract_interp/locations.mli
@@ -194,9 +194,6 @@ module Location_Bytes : sig
(** {2 Misc} *)
- val iter_on_strings :
- skip:Base.t option -> (Base.t -> string -> int -> int -> unit) -> t -> unit
-
(** [is_relationable loc] returns [true] iff [loc] represents a single
memory location. *)
val is_relationable: t -> bool
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index 412c945293053724d86025b26b3ebab33b0905ce..6deba7d75d1e529660d1516ff905088ba8af6f8d 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -533,11 +533,31 @@ let parse_cabs = function
let cpp_command = build_cpp_cmd cmdl supp_args (f:>string) (ppf:>string) in
if Sys.command cpp_command <> 0 then begin
safe_remove_file ppf;
+ let possible_cause =
+ if Kernel.JsonCompilationDatabase.is_set () then
+ if not (Json_compilation_database.has_entry f) then
+ Format.asprintf "note: %s is set but \
+ contains no entries for '%a'.@ "
+ Kernel.JsonCompilationDatabase.option_name
+ Datatype.Filepath.pretty f
+ else ""
+ else
+ if not (Kernel.CppExtraArgs.is_set ()) &&
+ not (Kernel.CppExtraArgsPerFile.is_set ()) &&
+ not (Kernel.CppCommand.is_set ()) then
+ Format.asprintf
+ "this is possibly due to missing preprocessor flags;@ \
+ consider options %s, %s or %s.@ "
+ Kernel.CppExtraArgs.option_name
+ Kernel.JsonCompilationDatabase.option_name
+ Kernel.CppCommand.option_name
+ else ""
+ in
Kernel.abort
"failed to run: %s@\n\
- you may set the CPP environment variable to select the proper \
- preprocessor command or use the option \"-cpp-command\"."
- cpp_command
+ %sSee chapter \"Preparing the Sources\" in the Frama-C user manual \
+ for more details."
+ cpp_command possible_cause
end;
let ppf =
if Kernel.ReadAnnot.get() &&
diff --git a/src/kernel_services/ast_queries/json_compilation_database.ml b/src/kernel_services/ast_queries/json_compilation_database.ml
index 091216de519479409665cb4a4cb5bf1f27a94a8d..5e0124ac2b1d59fb49d71896598f905243a8cec7 100644
--- a/src/kernel_services/ast_queries/json_compilation_database.ml
+++ b/src/kernel_services/ast_queries/json_compilation_database.ml
@@ -239,32 +239,33 @@ let parse_entry jcdb_dir r =
| Not_found ->
Flags.add path flags
+let compute_flags_from_file () =
+ let database = Kernel.JsonCompilationDatabase.get () in
+ let jcdb_dir, jcdb_path =
+ if Sys.is_directory database then
+ database, Filename.concat database "compile_commands.json"
+ else Filename.dirname database, database
+ in
+ Kernel.feedback ~dkey:Kernel.dkey_compilation_db
+ "using compilation database: %s" jcdb_path;
+ begin
+ try
+ let r_list =
+ Yojson.Basic.from_file jcdb_path |> Yojson.Basic.Util.to_list
+ in
+ List.iter (parse_entry jcdb_dir) r_list;
+ with
+ | Sys_error msg
+ | Yojson.Json_error msg
+ | Yojson.Basic.Util.Type_error (msg, _) ->
+ Kernel.abort "could not parse compilation database: %s@ %s"
+ database msg
+ end;
+ Flags.mark_as_computed ()
+
let get_flags f =
if Kernel.JsonCompilationDatabase.get () <> "" then begin
- if not (Flags.is_computed ()) then begin
- let database = Kernel.JsonCompilationDatabase.get () in
- let jcdb_dir, jcdb_path =
- if Sys.is_directory database then
- database, Filename.concat database "compile_commands.json"
- else Filename.dirname database, database
- in
- Kernel.feedback ~dkey:Kernel.dkey_compilation_db
- "using compilation database: %s" jcdb_path;
- begin
- try
- let r_list =
- Yojson.Basic.from_file jcdb_path |> Yojson.Basic.Util.to_list
- in
- List.iter (parse_entry jcdb_dir) r_list;
- with
- | Sys_error msg
- | Yojson.Json_error msg
- | Yojson.Basic.Util.Type_error (msg, _) ->
- Kernel.abort "could not parse compilation database: %s@ %s"
- database msg
- end;
- Flags.mark_as_computed ()
- end;
+ if not (Flags.is_computed ()) then compute_flags_from_file ();
try
let flags = Flags.find f in
Kernel.feedback ~dkey:Kernel.dkey_compilation_db
@@ -276,3 +277,7 @@ let get_flags f =
[]
end
else []
+
+let has_entry f =
+ if not (Flags.is_computed ()) then compute_flags_from_file ();
+ Flags.mem f
diff --git a/src/kernel_services/ast_queries/json_compilation_database.mli b/src/kernel_services/ast_queries/json_compilation_database.mli
index 9e3101b1d8a2ead1ee26330ee039c88749c0dbee..5b9f18f1b087c5dc1b185eb10404de4584f0f49d 100644
--- a/src/kernel_services/ast_queries/json_compilation_database.mli
+++ b/src/kernel_services/ast_queries/json_compilation_database.mli
@@ -24,3 +24,9 @@
in the JSON compilation database (when enabled), or the empty string
otherwise. If not empty, the flags always start with a space. *)
val get_flags : Datatype.Filepath.t -> string list
+
+(** [has_entry f] returns true iff [f] has an entry in the JSON compilation
+ database. Must only be called if a JCDB file has been specified.
+ @since Frama-C+dev
+*)
+val has_entry : Datatype.Filepath.t -> bool
diff --git a/src/kernel_services/plugin_entry_points/kernel.ml b/src/kernel_services/plugin_entry_points/kernel.ml
index 47c5174627a24ad9e96c2092ceaea97ea0840caf..0d5cfc8f14bd3213c0d186142b7ed97f41605dd9 100644
--- a/src/kernel_services/plugin_entry_points/kernel.ml
+++ b/src/kernel_services/plugin_entry_points/kernel.ml
@@ -592,6 +592,7 @@ module Time =
end)
let () = Parameter_customize.set_group messages
+let () = Parameter_customize.do_not_projectify ()
module SymbolicPath =
String_set (* TODO: to be replaced by an hashtbl *)
(struct
diff --git a/src/libraries/utils/markdown.ml b/src/libraries/utils/markdown.ml
index 3b609f20f2086bf309d278e3c4cc2600228557ef..92153e7eb31cd0ecae9415f5855ecf31d5ef8725 100644
--- a/src/libraries/utils/markdown.ml
+++ b/src/libraries/utils/markdown.ml
@@ -131,13 +131,14 @@ let codeblock ?(lang="") content =
[Code_block(lang,lines)]
) fmt content
-let text text = [Text text]
-let list items = [UL items]
-let enum items = [OL items]
-let description items = [DL items]
-
-let par text = [Block [Text text]]
-let block b = [Block b]
+let text text = if text = [] then [] else [Text text]
+let par text = if text = [] then [] else [Block [Text text]]
+let quote text = if text = [] then [] else [Block [Block_quote [Block [Text text]]]]
+let block block = if block = [] then [] else [Block block]
+let list items = if items = [] then [] else [UL items]
+let enum items = if items = [] then [] else [OL items]
+let table table = if table.content = [] then [] else [Table table]
+let description items = if items = [] then [] else [DL items]
(* -------------------------------------------------------------------------- *)
(* --- Sectioning --- *)
@@ -217,7 +218,7 @@ let relativize page target =
| [] -> assert false
| [_f2 ] ->
(* it's the length of the argument to go_up that matters, not
- its exact content *)
+ its exact content *)
go_up p1 @ l2
| d2 :: p2 when d2 = d1 -> remove_common p1 p2
| _ -> go_up p1 @ l2
@@ -228,7 +229,8 @@ let relativize page target =
let pp_href ?(page="") fmt = function
| URL s -> Format.pp_print_string fmt s
| Page s -> Format.pp_print_string fmt (relativize page s)
- | Section (p,s) -> Format.fprintf fmt "%s#%s" (relativize page p) (label s)
+ | Section("",s) -> Format.fprintf fmt "#%s" (label s)
+ | Section(p,s) -> Format.fprintf fmt "%s#%s" (relativize page p) (label s)
let rec pp_inline ?page fmt =
function
diff --git a/src/libraries/utils/markdown.mli b/src/libraries/utils/markdown.mli
index 4b511b0350f2f12025071b6fabaa6d8789d6d4b3..08bbe4125414b1adbb252caf89c91b6dd259cb18 100644
--- a/src/libraries/utils/markdown.mli
+++ b/src/libraries/utils/markdown.mli
@@ -161,9 +161,15 @@ val codeblock : ?lang:string -> ('a,Format.formatter,unit,block) format4 -> 'a
(** Single Paragraph element *)
val par : text -> elements
+(** Quoted Paragraph element *)
+val quote : text -> elements
+
(** Block element *)
val block : block -> elements
+(** Table element *)
+val table : table -> elements
+
(** Get the content of a file as raw markdown.
@raise Sys_error if there's no such file.
*)
diff --git a/src/plugins/dive/server_interface.ml b/src/plugins/dive/server_interface.ml
index c80a64405a8e1a0ef15b57487b4429728382618f..65179a2d79131c57c561a5d7e9ca3e00228c85f7 100644
--- a/src/plugins/dive/server_interface.ml
+++ b/src/plugins/dive/server_interface.ml
@@ -33,139 +33,119 @@ let get_graph =
graph := Some g;
g
-
-let page = Doc.page (`Plugin "dive")
- ~title:"Dive Services"
- ~filename:"dive.md"
+let package = Package.package ~plugin:"dive" ~title:"Dive Services" ()
module Graph =
struct
type t = Imprecision_graph.t
- let syntax = Syntax.any
+ let jtype = Data.Jany.jtype
let to_json = Imprecision_graph.to_json
end
module GraphDiff =
struct
type t = Imprecision_graph.t * Graph_types.graph_diff
- let syntax = Syntax.any
+ let jtype = Data.Jany.jtype
let to_json = fun (g,d) -> Imprecision_graph.diff_to_json g d
end
-module Variable = Data.Collection (struct
- let name = "dive-variable-name"
- let descr = Markdown.plain "The name of variable of the program"
-
- let signature = Data.Record.signature ~page ~name ~descr ()
+module Variable =
+struct
+ let name = "variableName"
+ let descr = Markdown.plain "The name of variable of the program"
+
+ let signature = Data.Record.signature ()
+
+ let fun_field = Data.Record.option signature
+ ~name:"funName"
+ ~descr:(Markdown.plain "owner function for a local variable")
+ (module Data.Jalpha)
+
+ let var_field = Data.Record.field signature
+ ~name:"varName"
+ ~descr:(Markdown.plain "variable name")
+ (module Data.Jalpha)
+
+ type t = Cil_types.varinfo
+
+ let data = Data.Record.publish ~package ~name ~descr signature
+ module R = (val data : Data.Record.S with type r = t)
+
+ let jtype = R.jtype
+
+ let to_json v =
+ let varname = v.Cil_types.vname in
+ let fields = R.default |> R.set var_field varname in
+ let fields = match Kernel_function.find_defining_kf v with
+ | Some kf -> fields |> R.set fun_field (Some (Kernel_function.get_name kf))
+ | None -> fields
+ in
+ R.to_json fields
+
+ let of_json json =
+ let open Yojson.Basic.Util in
+ let funname =
+ try Some (json |> member "fun" |> to_string)
+ with Not_found -> None
+ and varname = json |> member "var" |> to_string in
+ match funname with
+ | Some name ->
+ let kf =
+ try
+ Globals.Functions.find_by_name name
+ with Not_found ->
+ Data.failure "no function '%s'" name
+ in
+ let vi =
+ try Globals.Vars.find_from_astinfo varname (Cil_types.VLocal kf)
+ with Not_found ->
+ try Globals.Vars.find_from_astinfo varname (Cil_types.VFormal kf)
+ with Not_found ->
+ Data.failure "no variable '%s' in function '%s'"
+ varname name
+ in
+ vi
+ | None ->
+ match
+ Globals.Syntactic_search.find_in_scope varname Cil_types.Program
+ with
+ | Some vi -> vi
+ | None ->
+ Data.failure "no global variable '%s'" varname
+end
- let _fun_field = Data.Record.option signature
- ~descr:(Markdown.plain "owner function for a local variable")
- (module Data.Jstring)
+module Node : Data.S with type t = Graph_types.node =
+struct
+ type t = Graph_types.node
- let _var_field = Data.Record.field signature
- ~descr:(Markdown.plain "variable name")
- (module Data.Jstring)
+ let jtype = Package.Jindex "dive-node"
- type t = Cil_types.varinfo
- module R =
- (val (Data.Record.publish signature): Data.Record.S with type r = t)
+ let to_json node =
+ `Int node.Graph_types.node_key
- let syntax = R.syntax
+ let of_json json =
+ let open Yojson.Basic.Util in
+ let node_key = to_int json in
+ try
+ Build.find_node (get_graph ()) node_key
+ with Not_found ->
+ Data.failure "no node '%d' in the current graph" node_key
+end
- let to_json v =
- let varname = v.Cil_types.vname in
- let fields = [ "var", `String varname ] in
- let fields = match Kernel_function.find_defining_kf v with
- | Some kf -> ("fun", `String (Kernel_function.get_name kf)) :: fields
- | None -> fields
- in
- `Assoc fields
-
- let of_json json =
- let open Yojson.Basic.Util in
- let funname =
- try Some (json |> member "fun" |> to_string)
- with Not_found -> None
- and varname = json |> member "var" |> to_string in
- match funname with
- | Some name ->
- let kf =
- try
- Globals.Functions.find_by_name name
- with Not_found ->
- Data.failure "no function '%s'" name
- in
- let vi =
- try Globals.Vars.find_from_astinfo varname (Cil_types.VLocal kf)
- with Not_found ->
- try Globals.Vars.find_from_astinfo varname (Cil_types.VFormal kf)
- with Not_found ->
- Data.failure "no variable '%s' in function '%s'"
- varname name
- in
- vi
- | None ->
- match
- Globals.Syntactic_search.find_in_scope varname Cil_types.Program
- with
- | Some vi -> vi
- | None ->
- Data.failure "no global variable '%s'" varname
- end)
-
-module Function = Data.Collection (struct
- type t = Cil_types.kernel_function
-
- let syntax = Syntax.publish ~page ~name:"dive-function-name"
- ~synopsis:Syntax.string
- ~descr:(Markdown.plain "The name of a function of the program") ()
-
- let to_json kf =
- `String (Kernel_function.get_name kf)
-
- let of_json json =
- let open Yojson.Basic.Util in
- let name = to_string json in
- try
- Globals.Functions.find_by_name name
- with Not_found ->
- Data.failure "no function '%s'" name
- end)
-
-module Node = Data.Collection (struct
- type t = Graph_types.node
-
- let syntax = Syntax.publish ~page ~name:"dive-node"
- ~synopsis:Syntax.int
- ~descr:(Markdown.plain "A node identifier in the graph") ()
-
- let to_json node =
- `Int node.Graph_types.node_key
-
- let of_json json =
- let open Yojson.Basic.Util in
- let node_key = to_int json in
- try
- Build.find_node (get_graph ()) node_key
- with Not_found ->
- Data.failure "no node '%d' in the current graph" node_key
- end)
-
-
-let () = Request.register ~page
- ~kind:`GET ~name:"dive.graph"
+let () = Request.register ~package
+ ~kind:`GET ~name:"graph"
~descr:(Markdown.plain "Retrieve the whole graph")
~input:(module Data.Junit) ~output:(module Graph)
(fun () -> Build.get_graph (get_graph ()))
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.clear"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"clear"
~descr:(Markdown.plain "Erase the graph and start over with an empty one")
~input:(module Data.Junit) ~output:(module Data.Junit)
(fun () -> Build.clear (get_graph ()))
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.add_var"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"addVar"
~descr:(Markdown.plain "Add a variable to the graph")
~input:(module Variable) ~output:(module GraphDiff)
begin fun var ->
@@ -175,10 +155,10 @@ let () = Request.register ~page
Build.get_graph g, Build.take_last_differences g
end
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.add_function_alarms"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"addFunctionAlarms"
~descr:(Markdown.plain "Add all alarms of the given function")
- ~input:(module Function) ~output:(module GraphDiff)
+ ~input:(module Kernel_ast.Kf) ~output:(module GraphDiff)
begin fun kf ->
let depth = Self.DepthLimit.get () in
let g = get_graph () in
@@ -186,8 +166,8 @@ let () = Request.register ~page
Build.get_graph g, Build.take_last_differences g
end
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.explore"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"explore"
~descr:(Markdown.plain "Explore the graph starting from an existing vertex")
~input:(module Node) ~output:(module GraphDiff)
begin fun node ->
@@ -197,8 +177,8 @@ let () = Request.register ~page
Build.get_graph g, Build.take_last_differences g
end
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.show"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"show"
~descr:(Markdown.plain "Show the dependencies of an existing vertex")
~input:(module Node) ~output:(module GraphDiff)
begin fun node ->
@@ -208,8 +188,8 @@ let () = Request.register ~page
Build.get_graph g, Build.take_last_differences g
end
-let () = Request.register ~page
- ~kind:`EXEC ~name:"dive.hide"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"hide"
~descr:(Markdown.plain "Hide the dependencies of an existing vertex")
~input:(module Node) ~output:(module GraphDiff)
begin fun node ->
diff --git a/src/plugins/dive/server_interface.mli b/src/plugins/dive/server_interface.mli
index 6b8cd770d93ac0573027b76620aa88ab4cf0316b..29e37b35e739a47e62bc92e2a91173a62fcc6855 100644
--- a/src/plugins/dive/server_interface.mli
+++ b/src/plugins/dive/server_interface.mli
@@ -20,4 +20,4 @@
(* *)
(**************************************************************************)
-module Variable : Server.Data.S_collection with type t = Cil_types.varinfo
+module Variable : Server.Data.S with type t = Cil_types.varinfo
diff --git a/src/plugins/e-acsl/tests/bts/bts1398.c b/src/plugins/e-acsl/tests/bts/bts1398.c
index 408d069e4ee4d948e31e4575b133f57d414df23b..9dbd83d269e0b636508a91221f8dfbb292c62a9f 100644
--- a/src/plugins/e-acsl/tests/bts/bts1398.c
+++ b/src/plugins/e-acsl/tests/bts/bts1398.c
@@ -1,7 +1,3 @@
-/* run.config_dev
- COMMENT: issue with printf on CI
- DONTRUN:
-*/
/* run.config_ci
COMMENT: variadic function call
*/
diff --git a/src/plugins/e-acsl/tests/bts/oracle_ci/bts1398.res.oracle b/src/plugins/e-acsl/tests/bts/oracle_ci/bts1398.res.oracle
index a9c9e5c65e98d3f5f69ee0dbb2df47c1a5488782..196be478e598103ead236a8d08d82218bc6d0d9d 100644
--- a/src/plugins/e-acsl/tests/bts/oracle_ci/bts1398.res.oracle
+++ b/src/plugins/e-acsl/tests/bts/oracle_ci/bts1398.res.oracle
@@ -1,4 +1,4 @@
[e-acsl] beginning translation.
[e-acsl] translation done in project "e-acsl".
-[kernel:annot:missing-spec] tests/bts/bts1398.c:16: Warning:
+[kernel:annot:missing-spec] tests/bts/bts1398.c:12: Warning:
Neither code nor specification for function printf, generating default assigns from the prototype
diff --git a/src/plugins/e-acsl/tests/full-mmodel/addrOf.i b/src/plugins/e-acsl/tests/full-mmodel/addrOf.i
index c3726404e6f8607953c074eb6a0ce06307dc1867..281703719852d97b3b865510c8ea8d67c049a045 100644
--- a/src/plugins/e-acsl/tests/full-mmodel/addrOf.i
+++ b/src/plugins/e-acsl/tests/full-mmodel/addrOf.i
@@ -1,7 +1,3 @@
-/* run.config_dev
- COMMENT: issue with function pointers on CI
- DONTRUN:
-*/
/* run.config_ci
COMMENT: addrOf
*/
diff --git a/src/plugins/e-acsl/tests/full-mmodel/oracle_ci/gen_addrOf.c b/src/plugins/e-acsl/tests/full-mmodel/oracle_ci/gen_addrOf.c
index ca3a611c9bd240c6dba0d59cbea332b76cbe4f44..e7da245320f44ca617784993e0bf842400a92cff 100644
--- a/src/plugins/e-acsl/tests/full-mmodel/oracle_ci/gen_addrOf.c
+++ b/src/plugins/e-acsl/tests/full-mmodel/oracle_ci/gen_addrOf.c
@@ -19,7 +19,7 @@ void f(void)
int __gen_e_acsl_initialized;
__gen_e_acsl_initialized = __e_acsl_initialized((void *)p,sizeof(int));
__e_acsl_assert(__gen_e_acsl_initialized,"Assertion","f",
- "\\initialized(p)","tests/full-mmodel/addrOf.i",14);
+ "\\initialized(p)","tests/full-mmodel/addrOf.i",10);
}
/*@ assert \initialized(p); */ ;
__e_acsl_delete_block((void *)(& p));
@@ -82,7 +82,7 @@ int main(void)
__e_acsl_full_init((void *)(& x));
f();
__e_acsl_assert(& x == & x,"Assertion","main","&x == &x",
- "tests/full-mmodel/addrOf.i",20);
+ "tests/full-mmodel/addrOf.i",16);
/*@ assert &x ≡ &x; */ ;
__e_acsl_full_init((void *)(& __retres));
__retres = 0;
diff --git a/src/plugins/e-acsl/tests/memory/constructor.c b/src/plugins/e-acsl/tests/memory/constructor.c
index 32e630a32788679eb2571379587ebad512b111fe..8530264c83f3dff89a26d3dc0beaa254942795a8 100644
--- a/src/plugins/e-acsl/tests/memory/constructor.c
+++ b/src/plugins/e-acsl/tests/memory/constructor.c
@@ -1,7 +1,3 @@
-/* run.config_dev
- COMMENT: issue with printf on CI
- DONTRUN:
-*/
/* run.config_ci
COMMENT: bts #2405. Memory not initialized for code executed before main.
*/
diff --git a/src/plugins/e-acsl/tests/memory/hidden_malloc.c b/src/plugins/e-acsl/tests/memory/hidden_malloc.c
index 3900421de1c7da2824fd45627ebcfb7fc1c453b8..7d220a59517efd7bd62e13946568cae3d0b613fd 100644
--- a/src/plugins/e-acsl/tests/memory/hidden_malloc.c
+++ b/src/plugins/e-acsl/tests/memory/hidden_malloc.c
@@ -1,7 +1,3 @@
-/* run.config_dev
- COMMENT: issue on CI
- DONTRUN:
-*/
/* run.config_ci
COMMENT: Malloc executed by a library function
*/
diff --git a/src/plugins/e-acsl/tests/memory/local_goto.c b/src/plugins/e-acsl/tests/memory/local_goto.c
index 397f145cc16cd6eb5cdcdce28a0e0a103f03921a..a5448bf07063eeaa318549d0c51931ddf7357998 100644
--- a/src/plugins/e-acsl/tests/memory/local_goto.c
+++ b/src/plugins/e-acsl/tests/memory/local_goto.c
@@ -1,7 +1,3 @@
-/* run.config_dev
- COMMENT: issue with printf on CI
- DONTRUN:
-*/
/* run.config_ci
COMMENT: Check that deleting statements before goto jumps takes into
COMMENT: account variable declarations given via local inits
diff --git a/src/plugins/e-acsl/tests/memory/oracle_ci/constructor.res.oracle b/src/plugins/e-acsl/tests/memory/oracle_ci/constructor.res.oracle
index c660eb1a183b3770435f15404e2c620d30c13493..850186d110a852c7deff7b8cb2ed345dd9a3abe3 100644
--- a/src/plugins/e-acsl/tests/memory/oracle_ci/constructor.res.oracle
+++ b/src/plugins/e-acsl/tests/memory/oracle_ci/constructor.res.oracle
@@ -1,4 +1,4 @@
[e-acsl] beginning translation.
[e-acsl] translation done in project "e-acsl".
-[kernel:annot:missing-spec] tests/memory/constructor.c:20: Warning:
+[kernel:annot:missing-spec] tests/memory/constructor.c:16: Warning:
Neither code nor specification for function printf, generating default assigns from the prototype
diff --git a/src/plugins/e-acsl/tests/memory/oracle_ci/gen_local_goto.c b/src/plugins/e-acsl/tests/memory/oracle_ci/gen_local_goto.c
index 707853628e0809429f024754938dc89d741936cc..2cf1cc44c0cd0dd389bce183c8fa9c4fdb3ef873 100644
--- a/src/plugins/e-acsl/tests/memory/oracle_ci/gen_local_goto.c
+++ b/src/plugins/e-acsl/tests/memory/oracle_ci/gen_local_goto.c
@@ -54,7 +54,7 @@ int main(int argc, char const **argv)
__gen_e_acsl_valid = __e_acsl_valid((void *)(& a),sizeof(int),
(void *)(& a),(void *)0);
__e_acsl_assert(__gen_e_acsl_valid,"Assertion","main","\\valid(&a)",
- "tests/memory/local_goto.c",29);
+ "tests/memory/local_goto.c",25);
}
/*@ assert \valid(&a); */ ;
if (t == 2) {
@@ -71,7 +71,7 @@ int main(int argc, char const **argv)
__gen_e_acsl_valid_2 = __e_acsl_valid((void *)(& b),sizeof(int),
(void *)(& b),(void *)0);
__e_acsl_assert(__gen_e_acsl_valid_2,"Assertion","main","\\valid(&b)",
- "tests/memory/local_goto.c",40);
+ "tests/memory/local_goto.c",36);
}
/*@ assert \valid(&b); */ ;
printf(__gen_e_acsl_literal_string_2,t,__gen_e_acsl_literal_string_4);
diff --git a/src/plugins/e-acsl/tests/memory/oracle_ci/hidden_malloc.res.oracle b/src/plugins/e-acsl/tests/memory/oracle_ci/hidden_malloc.res.oracle
index 7bb9d547bffed4a48e6a08788bb7ec3e12e802c2..cecec801d917584a0d8bcf334b1f14c947fb38a8 100644
--- a/src/plugins/e-acsl/tests/memory/oracle_ci/hidden_malloc.res.oracle
+++ b/src/plugins/e-acsl/tests/memory/oracle_ci/hidden_malloc.res.oracle
@@ -1,9 +1,9 @@
-[kernel:typing:implicit-function-declaration] tests/memory/hidden_malloc.c:15: Warning:
+[kernel:typing:implicit-function-declaration] tests/memory/hidden_malloc.c:11: Warning:
Calling undeclared function realpath. Old style K&R code?
[e-acsl] beginning translation.
[e-acsl] translation done in project "e-acsl".
-[kernel:annot:missing-spec] tests/memory/hidden_malloc.c:15: Warning:
+[kernel:annot:missing-spec] tests/memory/hidden_malloc.c:11: Warning:
Neither code nor specification for function realpath, generating default assigns from the prototype
-[eva:invalid-assigns] tests/memory/hidden_malloc.c:15:
+[eva:invalid-assigns] tests/memory/hidden_malloc.c:11:
Completely invalid destination for assigns clause *((char *)x_1 + (0 ..)).
Ignoring.
diff --git a/src/plugins/e-acsl/tests/memory/oracle_ci/local_goto.res.oracle b/src/plugins/e-acsl/tests/memory/oracle_ci/local_goto.res.oracle
index 74588e72426d633d658a62543d219708afb71011..142c3f2be0104e92d2deba3a08cd8d2a0b4b1f10 100644
--- a/src/plugins/e-acsl/tests/memory/oracle_ci/local_goto.res.oracle
+++ b/src/plugins/e-acsl/tests/memory/oracle_ci/local_goto.res.oracle
@@ -1,4 +1,4 @@
[e-acsl] beginning translation.
[e-acsl] translation done in project "e-acsl".
-[kernel:annot:missing-spec] tests/memory/local_goto.c:41: Warning:
+[kernel:annot:missing-spec] tests/memory/local_goto.c:37: Warning:
Neither code nor specification for function printf, generating default assigns from the prototype
diff --git a/src/plugins/e-acsl/tests/test_config_dev.in b/src/plugins/e-acsl/tests/test_config_dev.in
index 8a01dabc2fff701b297a64e5ca32911b5fc81414..b425a92ef845aa9c2b780656c0a153c19f48ee3b 100644
--- a/src/plugins/e-acsl/tests/test_config_dev.in
+++ b/src/plugins/e-acsl/tests/test_config_dev.in
@@ -6,7 +6,7 @@ MACRO: EACSL_ERR @PTEST_NAME@.e-acsl.err.log
COMMENT: Define the following macro to "no" in a test to stop the execution of `e-acsl-gcc.sh`
MACRO: ROOT_EACSL_GCC_ENABLE yes
COMMENT: Default options for `e-acsl-gcc.sh`
-MACRO: ROOT_EACSL_GCC_MISC_OPTS -D -q -X
+MACRO: ROOT_EACSL_GCC_MISC_OPTS -q -X
COMMENT: Default options for the frama-c invocation
MACRO: ROOT_EACSL_GCC_FC_EXTRA -journal-disable -verbose 0 -kernel-warn-key *=inactive
COMMENT: Define the following macro in a test to pass extra options to the frama-c invocation
diff --git a/src/plugins/report/tests/report/classify.c b/src/plugins/report/tests/report/classify.c
index 050fe0fd4bcd1497c4d4cab535dcece5fe5d90b6..3ee8df0b80ad14afc530a3013f7067df128c4ec8 100644
--- a/src/plugins/report/tests/report/classify.c
+++ b/src/plugins/report/tests/report/classify.c
@@ -1,5 +1,5 @@
/* run.config
- CMD: @frama-c@ -kernel-warn-key=annot-error=active -no-autoload-plugins -load-module wp,report -report-output @PTEST_RESULT@/classified.@PTEST_NUMBER@.json -wp -wp-msg-key no-time-info
+ CMD: @frama-c@ -kernel-warn-key=annot-error=active -no-autoload-plugins -load-module wp,report -report-output @PTEST_RESULT@/classified.@PTEST_NUMBER@.json -wp -wp-msg-key shell
LOG: classified.@PTEST_NUMBER@.json
OPT: -wp-prover qed -report-unclassified-untried REVIEW -then -report-classify
LOG: classified.@PTEST_NUMBER@.json
diff --git a/src/plugins/report/tests/report/oracle/classify.0.res.oracle b/src/plugins/report/tests/report/oracle/classify.0.res.oracle
index 2d9f271aea5752a9bbc3037c9c42b90aac05b38e..e19a301288f31daaee5a84de423e34be38e9a539 100644
--- a/src/plugins/report/tests/report/oracle/classify.0.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.0.res.oracle
@@ -1,3 +1,4 @@
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/report/tests/report/oracle/classify.1.res.oracle b/src/plugins/report/tests/report/oracle/classify.1.res.oracle
index 9266851bb999c61aaf138053b920459d475fb73d..442bb8d3b8ce3649bef6678accea16e983d104d3 100644
--- a/src/plugins/report/tests/report/oracle/classify.1.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.1.res.oracle
@@ -1,4 +1,5 @@
[report] Monitoring events
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/report/tests/report/oracle/classify.2.res.oracle b/src/plugins/report/tests/report/oracle/classify.2.res.oracle
index 8e0f90163361e74984979077ddaa1a85702be12e..974d340981d9d583ddecf5a335ebfbe03c3002a9 100644
--- a/src/plugins/report/tests/report/oracle/classify.2.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.2.res.oracle
@@ -1,4 +1,5 @@
[report] Monitoring events
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/report/tests/report/oracle/classify.3.res.oracle b/src/plugins/report/tests/report/oracle/classify.3.res.oracle
index 5fab349a04e38664af8b21b15febbb573588c6c7..91bb8b30a52c6ab24b75cf1c04a53d3cc15534d7 100644
--- a/src/plugins/report/tests/report/oracle/classify.3.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.3.res.oracle
@@ -1,5 +1,6 @@
[report] Monitoring events
[report] Loading 'tests/report/classify.json'
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/report/tests/report/oracle/classify.4.res.oracle b/src/plugins/report/tests/report/oracle/classify.4.res.oracle
index 4fe970e76ac2d9a5d2c965d22a6f185ebaeb2f95..ab13ead4ecb87d3507d41418ee453bf3a16f4fde 100644
--- a/src/plugins/report/tests/report/oracle/classify.4.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.4.res.oracle
@@ -1,5 +1,6 @@
[report] Monitoring events
[report] Loading 'tests/report/classify.json'
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/report/tests/report/oracle/classify.5.res.oracle b/src/plugins/report/tests/report/oracle/classify.5.res.oracle
index fe7d84466c0e64effca171af82723994cecf7759..bab75d5f591e203476328215f076bf5d0ad61a7a 100644
--- a/src/plugins/report/tests/report/oracle/classify.5.res.oracle
+++ b/src/plugins/report/tests/report/oracle/classify.5.res.oracle
@@ -1,5 +1,6 @@
[report] Monitoring events
[report] Loading 'tests/report/classify.json'
+# frama-c -wp [...]
[kernel] Parsing tests/report/classify.c (with preprocessing)
[kernel:annot-error] tests/report/classify.c:27: Warning:
unbound logic variable ignored. Ignoring code annotation
diff --git a/src/plugins/server/Makefile.in b/src/plugins/server/Makefile.in
index 0c9644098263ac6ff133193aad18149ea977694a..1fca7533e8446537747338ca3ffe3bc83eb281e5 100644
--- a/src/plugins/server/Makefile.in
+++ b/src/plugins/server/Makefile.in
@@ -39,8 +39,9 @@ PLUGIN_NAME:=Server
PLUGIN_CMO:= \
server_parameters \
jbuffer \
- doc syntax data \
- main request states \
+ package \
+ data main request states \
+ server_doc \
server_batch \
kernel_main \
kernel_project \
@@ -79,7 +80,10 @@ include $(FRAMAC_SHARE)/Makefile.dynamic
##############
SERVER_API= \
- doc.mli syntax.mli data.mli request.mli states.mli \
+ package.mli \
+ data.mli \
+ request.mli \
+ states.mli \
kernel_main.mli \
kernel_ast.mli \
kernel_properties.mli
diff --git a/src/plugins/server/data.ml b/src/plugins/server/data.ml
index 61b3dd34b373ef981f1432a9f6cd22b76d17630d..a298e490e43ceced5223d92f7713cb087ff1d4f2 100644
--- a/src/plugins/server/data.ml
+++ b/src/plugins/server/data.ml
@@ -20,33 +20,25 @@
(* *)
(**************************************************************************)
+open Package
+module Js = Yojson.Basic
+module Ju = Yojson.Basic.Util
+
(* -------------------------------------------------------------------------- *)
(* --- Data Encoding --- *)
(* -------------------------------------------------------------------------- *)
-module Js = Yojson.Basic
-module Ju = Yojson.Basic.Util
-
type json = Js.t
let pretty = Js.pretty_print ~std:false
module type S =
sig
type t
- val syntax : Syntax.t
+ val jtype : jtype
val of_json : json -> t
val to_json : t -> json
end
-module type Info =
-sig
- val page : Doc.page
- val name : string
- val descr : Markdown.text
-end
-
-type 'a data = (module S with type t = 'a)
-
exception InputError of string
let failure ?json msg =
@@ -63,7 +55,29 @@ let failure ?json msg =
let failure_from_type_error msg json =
failure ~json "%s" msg
-let page = Doc.page `Kernel ~title:"Basic Types" ~filename:"data.md"
+let package = Package.package ~name:"data" ~title:"Informations" ()
+
+(* -------------------------------------------------------------------------- *)
+(* --- Declared Type --- *)
+(* -------------------------------------------------------------------------- *)
+
+let derived ~package ~id jtype =
+ let module Md = Markdown in
+ begin
+ declare ~package ~name:(Derived.safe id).name
+ ~descr:(Md.plain "Safe decoder for" @ Md.code id.name)
+ (D_safe(id,jtype)) ;
+ declare ~package ~name:(Derived.loose id).name
+ ~descr:(Md.plain "Loose decoder for" @ Md.code id.name)
+ (D_loose(id,jtype)) ;
+ declare ~package ~name:(Derived.order id).name
+ ~descr:(Md.plain "Natural order for" @ Md.code id.name)
+ (D_order(id,jtype)) ;
+ end
+
+let declare ~package ~name ?descr jtype =
+ let id = declare_id ~package ~name ?descr (D_type jtype) in
+ derived ~package ~id jtype ; Jdata id
(* -------------------------------------------------------------------------- *)
(* --- Option --- *)
@@ -74,8 +88,7 @@ struct
type t = A.t option
let nullable = try ignore (A.of_json `Null) ; true with _ -> false
- let syntax =
- Syntax.option (if not nullable then A.syntax else Syntax.tuple [A.syntax])
+ let jtype = Joption (if not nullable then A.jtype else Jtuple [A.jtype])
let to_json = function
| None -> `Null
@@ -95,7 +108,7 @@ end
module Jpair(A : S)(B : S) : S with type t = A.t * B.t =
struct
type t = A.t * B.t
- let syntax = Syntax.tuple [A.syntax;B.syntax]
+ let jtype = Jtuple [A.jtype;B.jtype]
let to_json (x,y) = `List [ A.to_json x ; B.to_json y ]
let of_json = function
| `List [ ja ; jb ] -> A.of_json ja , B.of_json jb
@@ -105,7 +118,7 @@ end
module Jtriple(A : S)(B : S)(C : S) : S with type t = A.t * B.t * C.t =
struct
type t = A.t * B.t * C.t
- let syntax = Syntax.tuple [A.syntax;B.syntax;C.syntax]
+ let jtype = Jtuple [A.jtype;B.jtype;C.jtype]
let to_json (x,y,z) = `List [ A.to_json x ; B.to_json y ; C.to_json z ]
let of_json = function
| `List [ ja ; jb ; jc ] -> A.of_json ja , B.of_json jb , C.of_json jc
@@ -119,7 +132,15 @@ end
module Jlist(A : S) : S with type t = A.t list =
struct
type t = A.t list
- let syntax = Syntax.array A.syntax
+ let jtype = Jlist A.jtype
+ let to_json xs = `List (List.map A.to_json xs)
+ let of_json js = List.map A.of_json (Ju.to_list js)
+end
+
+module Jalist(A : S) : S with type t = A.t list =
+struct
+ type t = A.t list
+ let jtype = Jarray A.jtype
let to_json xs = `List (List.map A.to_json xs)
let of_json js = List.map A.of_json (Ju.to_list js)
end
@@ -131,31 +152,11 @@ end
module Jarray(A : S) : S with type t = A.t array =
struct
type t = A.t array
- let syntax = Syntax.array A.syntax
+ let jtype = Jarray A.jtype
let to_json xs = `List (List.map A.to_json (Array.to_list xs))
let of_json js = Array.of_list @@ List.map A.of_json (Ju.to_list js)
end
-(* -------------------------------------------------------------------------- *)
-(* --- Collections --- *)
-(* -------------------------------------------------------------------------- *)
-
-module type S_collection =
-sig
- include S
- module Joption : S with type t = t option
- module Jlist : S with type t = t list
- module Jarray : S with type t = t array
-end
-
-module Collection(A : S) : S_collection with type t = A.t =
-struct
- include A
- module Joption = Joption(A)
- module Jlist = Jlist(A)
- module Jarray = Jarray(A)
-end
-
(* -------------------------------------------------------------------------- *)
(* --- Atomic Types --- *)
(* -------------------------------------------------------------------------- *)
@@ -163,7 +164,7 @@ end
module Junit : S with type t = unit =
struct
type t = unit
- let syntax = Syntax.unit
+ let jtype = Jnull
let of_json _js = ()
let to_json () = `Null
end
@@ -171,65 +172,123 @@ end
module Jany : S with type t = json =
struct
type t = json
- let syntax = Syntax.any
+ let jtype = Jany
let of_json js = js
let to_json js = js
end
-module Jbool : S_collection with type t = bool =
- Collection
- (struct
- type t = bool
- let syntax = Syntax.boolean
- let of_json = Ju.to_bool
- let to_json b = `Bool b
- end)
+module Jbool : S with type t = bool =
+struct
+ type t = bool
+ let jtype = Jboolean
+ let of_json = Ju.to_bool
+ let to_json b = `Bool b
+end
-module Jint : S_collection with type t = int =
- Collection
- (struct
- type t = int
- let syntax = Syntax.int
- let of_json = Ju.to_int
- let to_json n = `Int n
- end)
+module Jint : S with type t = int =
+struct
+ type t = int
+ let jtype = Jnumber
+ let of_json = Ju.to_int
+ let to_json n = `Int n
+end
-module Jfloat : S_collection with type t = float =
- Collection
- (struct
- type t = float
- let syntax = Syntax.number
- let of_json = Ju.to_number
- let to_json v = `Float v
- end)
+module Jfloat : S with type t = float =
+struct
+ type t = float
+ let jtype = Jnumber
+ let of_json = Ju.to_number
+ let to_json v = `Float v
+end
-module Jstring : S_collection with type t = string =
- Collection
- (struct
- type t = string
- let syntax = Syntax.string
- let of_json = Ju.to_string
- let to_json s = `String s
- end)
+module Jstring : S with type t = string =
+struct
+ type t = string
+ let jtype = Jstring
+ let of_json = Ju.to_string
+ let to_json s = `String s
+end
-module Jident : S_collection with type t = string =
- Collection
- (struct
- type t = string
- let syntax = Syntax.ident
- let of_json = Ju.to_string
- let to_json s = `String s
- end)
+module Jalpha : S with type t = string =
+struct
+ type t = string
+ let jtype = Jalpha
+ let of_json = Ju.to_string
+ let to_json s = `String s
+end
-let text_page = Doc.page `Kernel ~title:"Rich Text Format" ~filename:"text.md"
+(* -------------------------------------------------------------------------- *)
+(* --- Text Datatypes --- *)
+(* -------------------------------------------------------------------------- *)
+
+module Jmarkdown : S with type t = Markdown.text =
+struct
+ type t = Markdown.text
+ let jtype =
+ let descr = Markdown.plain "Markdown (inlined) text." in
+ declare ~package ~name:"markdown" ~descr Jstring
+ let of_json js = Markdown.plain (Ju.to_string js)
+ let to_json txt = `String (Pretty_utils.to_string Markdown.pp_text txt)
+end
module Jtext =
struct
include Jany
- let syntax = Syntax.publish ~page:text_page ~name:"text"
- ~synopsis:Syntax.any ~descr:(Markdown.plain "Formatted text.") ()
+ let jtype =
+ let descr = Markdown.plain
+ "Rich text format uses `[tag; …text ]` to apply \
+ the tag `tag` to the enclosed text. \
+ Empty tag `\"\"` can also used to simply group text together." in
+ let jdef = Junion [ Jnull; Jstring; Jlist Jself ] in
+ declare ~package ~name:"text" ~descr jdef
end
+(* -------------------------------------------------------------------------- *)
+(* --- Functional API --- *)
+(* -------------------------------------------------------------------------- *)
+
+type 'a data = (module S with type t = 'a)
+
+let junit : unit data = (module Junit)
+let jany : json data = (module Jany)
+let jbool : bool data = (module Jbool)
+let jint : int data = (module Jint)
+let jfloat : float data = (module Jfloat)
+let jstring : string data = (module Jstring)
+let jalpha : string data = (module Jalpha)
+
+let jkey ~kind =
+ let module JkeyKind =
+ struct
+ include Jstring
+ let jtype = Jkey kind
+ end in
+ (module JkeyKind : S with type t = string)
+
+let jindex ~kind =
+ let module JindexKind =
+ struct
+ include Jint
+ let jtype = Jindex kind
+ end in
+ (module JindexKind : S with type t = int)
+
+let joption (type a) (d : a data) : a option data =
+ let module A = Joption(val d) in
+ (module A : S with type t = a option)
+
+let jlist (type a) (d : a data) : a list data =
+ let module A = Jlist(val d) in
+ (module A : S with type t = a list)
+
+let jalist (type a) (d : a data) : a list data =
+ let module A = Jalist(val d) in
+ (module A : S with type t = a list)
+
+let jarray (type a) (d : a data) : a array data =
+ let module A = Jarray(val d) in
+ (module A : S with type t = a array)
+
(* -------------------------------------------------------------------------- *)
(* --- Records --- *)
(* -------------------------------------------------------------------------- *)
@@ -248,10 +307,7 @@ struct
}
type 'a signature = {
- page : Doc.page ;
- name : string ;
- descr : Markdown.text ;
- mutable fields : Syntax.field list ;
+ mutable fields : fieldInfo list ;
mutable default : 'a record ;
mutable published : bool ;
}
@@ -266,29 +322,27 @@ struct
val set : (r,'a) field -> 'a -> t -> t
end
- let signature ~page ~name ~descr () = {
- page ; name ; descr ;
+ let signature () = {
published = false ;
fields = [] ;
default = Fmap.empty ;
}
- let invalid name reason =
- let msg = Printf.sprintf "Server.Data.Record.%s: %s" name reason in
- raise (Invalid_argument msg)
+ let not_published s =
+ if s.published then
+ raise (Invalid_argument "Server.Data.Record: already published")
let field (type a r) (s : r signature)
~name ~descr ?default (d : a data) : (r,a) field =
- if s.published then
- invalid s.name (Printf.sprintf "published record (%s)" name) ;
+ not_published s ;
let module D = (val d) in
begin match default with
| None -> ()
| Some v -> s.default <- Fmap.add name (D.to_json v) s.default
end ;
- let field = Syntax.{
+ let field = Package.{
fd_name = name ;
- fd_syntax = D.syntax ;
+ fd_type = D.jtype ;
fd_descr = descr ;
} in
s.fields <- field :: s.fields ;
@@ -299,12 +353,11 @@ struct
let option (type a r) (s : r signature)
~name ~descr (d : a data) : (r,a option) field =
- if s.published then
- invalid s.name (Printf.sprintf "published record (%s)" name) ;
+ not_published s ;
let module D = (val d) in
- let field = Syntax.{
+ let field = Package.{
fd_name = name ;
- fd_syntax = option D.syntax ;
+ fd_type = Joption D.jtype ;
fd_descr = descr ;
} in
s.fields <- field :: s.fields ;
@@ -316,19 +369,17 @@ struct
| Some v -> Fmap.add name (D.to_json v) r in
{ member ; getter ; setter }
- let publish (type r) (s : r signature) =
- if s.published then
- invalid s.name "already published record" ;
+ let publish (type r) ~package ~name ?(descr=[]) (s : r signature) =
+ not_published s ;
let module M =
struct
type nonrec r = r
type t = r record
- let descr = s.descr
- let syntax =
- let fields = Syntax.fields ~title:"Field" (List.rev s.fields) in
- Syntax.publish ~page:s.page ~name:s.name ~descr
- ~synopsis:(Syntax.record [])
- ~details:[fields] ()
+ let jtype =
+ let fields = List.rev s.fields in
+ let id = Package.declare_id ~package ~name ~descr (D_record fields) in
+ derived ~package ~id (Jrecord (List.map Package.field fields)) ;
+ Jdata id
let default = s.default
let has fd r = fd.member r
let get fd r = fd.getter r
@@ -349,95 +400,75 @@ struct
end
-module Jmarkdown : S with type t = Markdown.text =
-struct
-
- type t = Markdown.text
- let syntax = Syntax.publish ~page
- ~name:"markdown" ~descr:(Markdown.plain "Markdown (inlined text)")
- ~synopsis:Syntax.string ()
- let of_json js = Markdown.plain (Ju.to_string js)
- let to_json txt =
- `String (Rich_text.to_string ~margin:80 (Markdown.pp_text ?page:None) txt)
-
-end
-
(* -------------------------------------------------------------------------- *)
(* --- Enums --- *)
(* -------------------------------------------------------------------------- *)
-module Tag = Collection
- (struct
- type t = Syntax.tag
-
- let syntax = Syntax.publish ~page ~name:"tag"
- ~descr:(Markdown.plain "Tag description")
- ~synopsis:(Syntax.record [
- "name",Syntax.string ;
- "label",Jmarkdown.syntax ;
- "descr",Jmarkdown.syntax ;
- ]) ()
-
- let to_json tg = `Assoc [
- "name", `String tg.Syntax.tag_name ;
- "label", Jmarkdown.to_json tg.tag_label ;
- "descr" , Jmarkdown.to_json tg.tag_descr ;
- ]
-
- let of_json js = Syntax.{
- tag_name = Ju.member "name" js |> Ju.to_string ;
- tag_label = Ju.member "label" js |> Jmarkdown.of_json ;
- tag_descr = Ju.member "descr" js |> Jmarkdown.of_json ;
- }
- end)
+module Tag =
+struct
+ type t = Package.tagInfo
+
+ let jtype = declare ~package ~name:"tag"
+ ~descr:(Markdown.plain "Enum Tag Description")
+ (Jrecord [
+ "name",Jalpha ;
+ "label",Jmarkdown.jtype ;
+ "descr",Jmarkdown.jtype ;
+ ])
+
+ let to_json tg = `Assoc Package.[
+ "name", `String tg.tg_name ;
+ "label", Jmarkdown.to_json tg.tg_label ;
+ "descr" , Jmarkdown.to_json tg.tg_descr ;
+ ]
+
+ let of_json js = Package.{
+ tg_name = Ju.member "name" js |> Ju.to_string ;
+ tg_label = Ju.member "label" js |> Jmarkdown.of_json ;
+ tg_descr = Ju.member "descr" js |> Jmarkdown.of_json ;
+ }
+
+end
module Enum =
struct
type 'a dictionary = {
- page : Doc.page ;
- name : string ;
- title : string ;
- descr : Markdown.text ;
values : (string,'a option) Hashtbl.t ;
vindex : ('a,string) Hashtbl.t ;
mutable syntax : Markdown.text ;
- mutable published : bool ;
- mutable tags : Syntax.tag list ;
+ mutable published : (package * string) option ;
+ mutable tags : tagInfo list ;
+ mutable prefix : tagInfo list ;
+ mutable lookup : ('a -> string) option ;
}
type 'a tag = string
- type 'a prefix = string
+ type 'a prefix = 'a dictionary * string
let tag_name tg = tg
let tag_label a = function
| None -> Markdown.plain (String.(capitalize_ascii (lowercase_ascii a)))
| Some lbl -> lbl
- let dictionary ~page ~name ~title ~descr () = {
- page ; name ; descr ; title ;
- published = false ;
+ let dictionary () = {
+ published = None ;
values = Hashtbl.create 0 ;
vindex = Hashtbl.create 0 ;
syntax = [] ;
+ prefix = [] ;
tags = [] ;
+ lookup = None ;
}
- let invalid name reason =
- let msg = Printf.sprintf "Server.Data.Enum.%s: %s" name reason in
- raise (Invalid_argument msg)
-
- let page (d : 'a dictionary) = d.page
- let name (d : 'a dictionary) = d.name
- let syntax (d : 'a dictionary) = d.syntax
-
- let tag (d : 'a dictionary) ~name ?label ~descr ?value () : 'a tag =
+ let tag ~name ?label ~descr ?value (d : 'a dictionary) : 'a tag =
if Hashtbl.mem d.values name then
- invalid d.name (Printf.sprintf "duplicate tag (%s)" name) ;
- let tg = Syntax.{
- tag_name = name ;
- tag_label = tag_label name label ;
- tag_descr = descr ;
+ ( let msg = Printf.sprintf "Server.Data.Enum: duplicate tag %S" name in
+ raise (Invalid_argument msg) );
+ let tg = Package.{
+ tg_name = name ;
+ tg_label = tag_label name label ;
+ tg_descr = descr ;
} in
d.tags <- tg :: d.tags ;
Hashtbl.add d.values name value ;
@@ -446,26 +477,55 @@ struct
| Some v -> Hashtbl.add d.vindex v name
end ; name
- let find_tag (d : 'a dictionary) name =
- if Hashtbl.mem d.values name then name else raise Not_found
+ let add ~name ?label ~descr ?value (d : 'a dictionary) : unit =
+ ignore (tag ~name ?label ~descr ?value d)
- let instance = Printf.sprintf "%s:%s"
+ let find (d : 'a dictionary) (tg : 'a tag) : 'a =
+ match Hashtbl.find d.values tg with
+ | Some v -> v
+ | None -> raise Not_found
- let prefix (d : 'a dictionary) ~prefix ?(var="*") ?label ~descr () =
- let tg = Syntax.{
- tag_name = instance prefix var ;
- tag_label = tag_label (prefix ^ ".") label ;
- tag_descr = descr ;
- } in
- d.tags <- tg :: d.tags ; prefix
+ let find_tag (d : 'a dictionary) name : 'a tag =
+ if Hashtbl.mem d.values name then name else
+ raise Not_found
- let extends d prefix ~name ?label ~descr ?value () =
- tag d ~name:(instance prefix name) ?label ~descr ?value ()
+ let lookup_index lookup vindex v =
+ match lookup with
+ | None -> Hashtbl.find vindex v
+ | Some f -> try f v with Not_found -> Hashtbl.find vindex v
- let to_json name vindex v =
- try `String (Hashtbl.find vindex v)
- with Not_found ->
- failure "[%s] Value not found" name
+ let lookup (d : 'a dictionary) (v: 'a) : 'a tag =
+ lookup_index d.lookup d.vindex v
+
+ let set_lookup (d : 'a dictionary) (tag : 'a -> 'a tag) =
+ d.lookup <- Some tag
+
+ let instance_name = Printf.sprintf "%s_%s"
+
+ let instance (_,prefix) = instance_name prefix
+
+ let prefix ~name ?(var="*") ?label ~descr (d : 'a dictionary) =
+ let tg = Package.{
+ tg_name = instance_name name var ;
+ tg_label = tag_label (name ^ ".") label ;
+ tg_descr = descr ;
+ } in
+ d.prefix <- tg :: d.prefix ; d , name
+
+ let extends ~name ?label ~descr ?value ((d,prefix) : 'a prefix) : 'a tag =
+ let name = tag ~name:(instance_name prefix name) ?label ~descr ?value d in
+ ( match d.published with
+ | None -> ()
+ | Some (package,name) ->
+ Package.update ~package ~name (D_enum (List.rev d.tags))
+ ) ; name
+
+ let to_json name lookup vindex v =
+ `String begin
+ try lookup_index lookup vindex v
+ with Not_found ->
+ failure "[%s] Value not found" name
+ end
let of_json name values js =
let tag = Ju.to_string js in
@@ -478,26 +538,24 @@ struct
let tags d = List.rev d.tags
- let publish (type a) (d : a dictionary) ?tag () =
- if d.published then
- invalid d.name "already published" ;
+ let publish (type a) ~package ~name ~descr (d : a dictionary) =
+ ( match d.published with
+ | None -> ()
+ | Some _ ->
+ let msg = "Server.Data.Enums: already published" in
+ raise (Invalid_argument msg) );
let module M =
struct
type t = a
- let descr = d.descr
- let syntax =
- let tags () = [Syntax.tags ~title:d.title (List.rev d.tags)] in
- Syntax.publish ~page:d.page ~name:d.name ~descr
- ~synopsis:(Syntax.string) ~generated:tags ()
- let of_json = of_json d.name d.values
- let to_json =
- match tag with
- | None -> to_json d.name d.vindex
- | Some to_tag -> fun x -> `String (to_tag x)
+ let jtype =
+ let enums = D_enum (List.rev d.tags) in
+ let id = Package.declare_id ~package ~name ~descr enums in
+ derived ~package ~id (Jenum id) ; Jdata id
+ let of_json = of_json name d.values
+ let to_json = to_json name d.lookup d.vindex
end in
begin
- d.published <- true ;
- d.syntax <- Syntax.text M.syntax ;
+ d.published <- Some (package,name) ;
(module M : S with type t = a)
end
@@ -507,6 +565,11 @@ end
(* --- Index --- *)
(* -------------------------------------------------------------------------- *)
+module type Info =
+sig
+ val name: string
+end
+
(** Simplified [Map.S] *)
module type Map =
sig
@@ -519,16 +582,12 @@ end
module type Index =
sig
- include S_collection
+ include S
val get : t -> int
val find : int -> t
val clear : unit -> unit
end
-let publish_id (module A : Info) =
- Syntax.publish
- ~page:A.page ~name:A.name ~synopsis:Syntax.int ~descr:A.descr ()
-
module INDEXER(M : Map)(I : Info) :
sig
type index
@@ -579,25 +638,26 @@ struct
end
-module Static(M : Map)(I : Info) : Index with type t = M.key =
+module Static(M : Map)(I : Info)
+ : Index with type t = M.key =
struct
module INDEX = INDEXER(M)(I)
let index = INDEX.create ()
let clear () = INDEX.clear index
let get = INDEX.get index
let find = INDEX.find index
- include Collection
- (struct
- type t = M.key
- let syntax = publish_id (module I)
- let of_json = INDEX.of_json index
- let to_json = INDEX.to_json index
- end)
+ include
+ (struct
+ type t = M.key
+ let jtype = Jindex I.name
+ let of_json = INDEX.of_json index
+ let to_json = INDEX.to_json index
+ end)
end
-module Index(M : Map)(I : Info) : Index with type t = M.key =
+module Index(M : Map)(I : Info)
+ : Index with type t = M.key =
struct
-
module INDEX = INDEXER(M)(I)
module TYPE : Datatype.S with type t = INDEX.index =
Datatype.Make
@@ -621,13 +681,13 @@ struct
let get a = INDEX.get (index()) a
let find id = INDEX.find (index()) id
- include Collection
- (struct
- type t = M.key
- let syntax = publish_id (module I)
- let of_json js = INDEX.of_json (index()) js
- let to_json v = INDEX.to_json (index()) v
- end)
+ include
+ (struct
+ type t = M.key
+ let jtype = Jindex I.name
+ let of_json js = INDEX.of_json (index()) js
+ let to_json v = INDEX.to_json (index()) v
+ end)
end
@@ -665,16 +725,16 @@ struct
let get = A.id
let find id = Hashtbl.find (lookup()) id
- include Collection
- (struct
- type t = A.t
- let syntax = publish_id (module I)
- let to_json a = `Int (get a)
- let of_json js =
- let k = Ju.to_int js in
- try find k
- with Not_found -> failure "[%s] No registered id #%d" I.name k
- end)
+ include
+ (struct
+ type t = A.t
+ let jtype = Jindex I.name
+ let to_json a = `Int (get a)
+ let of_json js =
+ let k = Ju.to_int js in
+ try find k
+ with Not_found -> failure "[%s] No registered id #%d" I.name k
+ end)
end
diff --git a/src/plugins/server/data.mli b/src/plugins/server/data.mli
index 07927c85842db6147e7aae90c12dcb80f79c28d8..9cd4625aa81d0bd2c126be7a1eb55bc408a9deea 100644
--- a/src/plugins/server/data.mli
+++ b/src/plugins/server/data.mli
@@ -55,57 +55,32 @@
time a JSON record or tag is needed. *)
(* -------------------------------------------------------------------------- *)
+open Package
+
type json = Json.t
-val page : Doc.page (** Documentation page for general purpose data types. *)
val pretty : Format.formatter -> json -> unit
(** Datatype module signature. *)
module type S =
sig
type t
- val syntax : Syntax.t (** readable description of the JSON format *)
+ val jtype : jtype
val of_json : json -> t
val to_json : t -> json
end
-
-(** Datatype informations. *)
-module type Info =
-sig
- val page : Doc.page
- val name : string
- val descr : Markdown.text
-end
-
-(** Polymorphic data value. *)
-type 'a data = (module S with type t = 'a)
-
-(* -------------------------------------------------------------------------- *)
-(** {2 Collections} *)
-(* -------------------------------------------------------------------------- *)
-
-module type S_collection =
-sig
- include S
- module Joption : S with type t = t option
- module Jlist : S with type t = t list
- module Jarray : S with type t = t array
-end
-
-module Collection(A : S) : S_collection with type t = A.t
-
(* -------------------------------------------------------------------------- *)
(** {2 Atomic Data} *)
(* -------------------------------------------------------------------------- *)
module Junit : S with type t = unit
module Jany : S with type t = json
-module Jbool : S_collection with type t = bool
-module Jint : S_collection with type t = int
-module Jfloat : S_collection with type t = float
-module Jstring : S_collection with type t = string
-module Jident : S_collection with type t = string (** Syntax is {i ident}. *)
+module Jbool : S with type t = bool
+module Jint : S with type t = int
+module Jfloat : S with type t = float
+module Jstring : S with type t = string
+module Jalpha : S with type t = string
module Jtext : S with type t = json (** Rich text encoding, see [Jbuffer]. *)
module Jmarkdown : S with type t = Markdown.text
@@ -117,8 +92,47 @@ module Joption(A : S) : S with type t = A.t option
module Jpair(A : S)(B : S) : S with type t = A.t * B.t
module Jtriple(A : S)(B : S)(C : S) : S with type t = A.t * B.t * C.t
module Jlist(A : S) : S with type t = A.t list
+module Jalist(A : S) : S with type t = A.t list
module Jarray(A : S) : S with type t = A.t array
+(* -------------------------------------------------------------------------- *)
+(** {2 Functional API} *)
+(* -------------------------------------------------------------------------- *)
+
+(** Polymorphic data value. *)
+type 'a data = (module S with type t = 'a)
+
+val junit : unit data
+val jany : json data
+val jbool : bool data
+val jint : int data
+val jfloat : float data
+val jstring : string data
+val jalpha : string data
+val jindex : kind:string -> int data
+val jkey : kind:string -> string data
+val jlist : 'a data -> 'a list data
+val jalist : 'a data -> 'a list data
+val jarray : 'a data -> 'a array data
+val joption : 'a data -> 'a option data
+
+(**
+ Declare the derived names for the provided type.
+ Shall not be used directely.
+*)
+val derived : package:package -> id:ident -> jtype -> unit
+
+(**
+ Declare a new type and returns its alias.
+ Same as [Jdata (declare_id ~package ~name (D_type js))].
+ Automatically declare the derived names.
+*)
+val declare :
+ package:package ->
+ name:string ->
+ ?descr:Markdown.text ->
+ jtype -> jtype
+
(* -------------------------------------------------------------------------- *)
(** {2 Records} *)
(* -------------------------------------------------------------------------- *)
@@ -167,8 +181,7 @@ sig
end
(** Create a new, opened record type. *)
- val signature : page:Doc.page -> name:string -> descr:Markdown.text ->
- unit -> 'a signature
+ val signature : unit -> 'a signature
(** Adds a field to an opened record. *)
val field : 'r signature ->
@@ -181,8 +194,8 @@ sig
('r,'a option) field
(** Publish and close an opened record. *)
- val publish : 'a signature ->
- (module S with type r = 'a)
+ val publish : package:package -> name:string -> ?descr:Markdown.text ->
+ 'a signature -> (module S with type r = 'a)
end
@@ -190,7 +203,7 @@ end
(** {2 Enums} *)
(* -------------------------------------------------------------------------- *)
-module Tag : S_collection with type t = Syntax.tag
+module Tag : S with type t = tagInfo
(** Enum factory.
@@ -218,9 +231,7 @@ sig
val tag_name : 'a tag -> string
(** Creates an opened, empty dictionary. *)
- val dictionary :
- page:Doc.page -> name:string -> title:string -> descr:Markdown.text ->
- unit -> 'a dictionary
+ val dictionary : unit -> 'a dictionary
(** Register a new tag in the dictionary.
The default label is the capitalized name.
@@ -230,11 +241,26 @@ sig
Registered values must be hashable with [Hashtbl.hash] function.
You may register a new tag {i after} the dictionary has been published. *)
- val tag : 'a dictionary ->
+ val tag :
name:string ->
?label:Markdown.text -> descr:Markdown.text ->
?value:'a ->
- unit -> 'a tag
+ 'a dictionary -> 'a tag
+
+ (** Same as [tag] but to not return the associated tag. *)
+ val add :
+ name:string ->
+ ?label:Markdown.text -> descr:Markdown.text ->
+ ?value:'a ->
+ 'a dictionary -> unit
+
+ (** Returns the value associated to some tag.
+ @raise Not_found if no value is associated to the tag. *)
+ val find: 'a dictionary -> 'a tag -> 'a
+
+ (** Returns the tag associated to a value.
+ @raise Not_found if no value is associated to the tag. *)
+ val lookup: 'a dictionary -> 'a -> 'a tag
(** Returns the tag from its name.
@raise Not_found if no tag has been registered with this name. *)
@@ -249,32 +275,35 @@ sig
You may register a new prefix-tag {i after} the dictionary has
been published. *)
- val prefix : 'a dictionary ->
- prefix:string -> ?var:string ->
+ val prefix :
+ name:string -> ?var:string ->
?label:Markdown.text -> descr:Markdown.text ->
- unit -> 'a prefix
+ 'a dictionary -> 'a prefix
(** Returns the tag for a value associated with the given prefix. *)
val instance : 'a prefix -> string -> 'a tag
(** Publish a new instance in the documentation. *)
- val extends : 'a dictionary -> 'a prefix ->
+ val extends :
name:string ->
?label:Markdown.text -> descr:Markdown.text ->
?value:'a ->
- unit -> 'a tag
+ 'a prefix -> 'a tag
(** Obtain all the tags registered in the dictionary so far. *)
val tags : 'a dictionary -> Tag.t list
- val page : 'a dictionary -> Doc.page
- val name : 'a dictionary -> string
- val syntax : 'a dictionary -> Markdown.text
+ (** Set tagging function for values. If the lookup function
+ raises `Not_found`, the dictionary will use the tag associated
+ with the provided value, if any. *)
+ val set_lookup : 'a dictionary -> ('a -> 'a tag) -> unit
- (** Publish the dictionary. No more tag nor prefix can be added afterwards. If
- no [~tag] function is provided, registered values with tags are used. *)
- val publish :
- 'a dictionary -> ?tag:('a -> 'a tag) -> unit -> (module S with type t = 'a)
+ (**
+ Publish the dictionary. No more tag nor prefix can be added afterwards.
+ If no [~tag] function is provided, the values registered with tags are used.
+ *)
+ val publish : package:package -> name:string -> descr:Markdown.text ->
+ 'a dictionary -> (module S with type t = 'a)
end
@@ -294,6 +323,12 @@ end
*)
(* -------------------------------------------------------------------------- *)
+(** Datatype information. *)
+module type Info =
+sig
+ val name: string
+end
+
(** Simplified [Map.S]. *)
module type Map =
sig
@@ -307,7 +342,7 @@ end
(** Datatype extended with access to value identifiers. *)
module type Index =
sig
- include S_collection
+ include S
val get : t -> int
val find : int -> t (** @raise Not_found if not registered. *)
val clear : unit -> unit
@@ -328,7 +363,7 @@ sig
end
(** Builds a {i projectified} index on types with {i unique} identifiers. *)
-module Identified(A : IdentifiedType)(I:Info) : Index with type t = A.t
+module Identified(A : IdentifiedType)(I : Info) : Index with type t = A.t
(* -------------------------------------------------------------------------- *)
(** {2 Error handling}
diff --git a/src/plugins/server/kernel_ast.ml b/src/plugins/server/kernel_ast.ml
index fb84672bd147830e8fb2a0d7389238c7ad787791..3868f9d799dc6a5b0e15bb248aae35e4ec5705da 100644
--- a/src/plugins/server/kernel_ast.ml
+++ b/src/plugins/server/kernel_ast.ml
@@ -21,19 +21,19 @@
(**************************************************************************)
open Data
-module Sy = Syntax
module Md = Markdown
module Js = Yojson.Basic.Util
+module Pkg = Package
open Cil_types
-let page = Doc.page `Kernel ~title:"Ast Services" ~filename:"ast.md"
+let package = Pkg.package ~title:"Ast Services" ~name:"ast" ~readme:"ast.md" ()
(* -------------------------------------------------------------------------- *)
(* --- Compute Ast --- *)
(* -------------------------------------------------------------------------- *)
-let () = Request.register ~page
- ~kind:`EXEC ~name:"kernel.ast.compute"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"compute"
~descr:(Md.plain "Ensures that AST is computed")
~input:(module Junit) ~output:(module Junit) Ast.compute
@@ -43,11 +43,14 @@ let () = Request.register ~page
(* The kind of a marker. *)
module MarkerKind = struct
- let t =
- Enum.dictionary ~page ~name:"markerkind" ~title:"Marker kind"
- ~descr:(Md.plain "Marker kind") ()
- let kind name = Enum.tag t ~name ~descr:(Md.plain name) ()
+ let kinds = Enum.dictionary ()
+
+ let kind name = Enum.tag ~name
+ ~descr:(Md.plain (String.capitalize_ascii name)) kinds
+
+ let var = kind "variable"
+ let fct = kind "function"
let expr = kind "expression"
let lval = kind "lvalue"
let decl = kind "declaration"
@@ -56,43 +59,25 @@ module MarkerKind = struct
let term = kind "term"
let prop = kind "property"
- let tag =
- let open Printer_tag in
- function
- | PStmt _ -> stmt
- | PStmtStart _ -> stmt
- | PVDecl _ -> decl
- | PLval _ -> lval
- | PExp _ -> expr
- | PTermLval _ -> term
- | PGlobal _ -> glob
- | PIP _ -> prop
-
- let data = Enum.publish t ~tag ()
- include (val data : S with type t = Printer_tag.localizable)
-end
-
-module MarkerVar = struct
- let t =
- Enum.dictionary ~page ~name:"markervar" ~title:"Marker variable"
- ~descr:(Md.plain "Identifies markers that are variables") ()
+ let () = Enum.set_lookup kinds
+ begin
+ let open Printer_tag in
+ function
+ | PStmt _ -> stmt
+ | PStmtStart _ -> stmt
+ | PVDecl _ -> decl
+ | PLval (_, _, (Var vi, NoOffset)) ->
+ if Cil.isFunctionType vi.vtype then fct else var
+ | PLval _ -> lval
+ | PExp _ -> expr
+ | PTermLval _ -> term
+ | PGlobal _ -> glob
+ | PIP _ -> prop
+ end
+
+ let data = Request.dictionary ~package
+ ~name:"markerKind" ~descr:(Md.plain "Marker kind") kinds
- let kind name = Enum.tag t ~name ~descr:(Md.plain name) ()
- let none = kind "no"
- let var = kind "variable"
- let fct = kind "function"
- let tag =
- let open Printer_tag in
- function
- | PLval (_, _, (Var vi, NoOffset))
- | PVDecl (_, _, vi)
- | PGlobal (GVar (vi, _, _) | GVarDecl (vi, _)) ->
- if Cil.isFunctionType vi.vtype then fct else var
- | PGlobal (GFun _ | GFunDecl _) -> fct
- | PLval _ | PStmt _ | PStmtStart _
- | PExp _ | PTermLval _ | PGlobal _ | PIP _ -> none
-
- let data = Enum.publish t ~tag ()
include (val data : S with type t = Printer_tag.localizable)
end
@@ -136,38 +121,33 @@ struct
let array =
let model = States.model () in
let () =
- States.column ~model
+ States.column
~name:"kind" ~descr:(Md.plain "Marker kind")
- ~data:(module MarkerKind) ~get:fst ()
- in
- let () =
- States.column ~model
- ~name:"var" ~descr:(Md.plain "Marker variable")
- ~data:(module MarkerVar) ~get:fst ()
+ ~data:(module MarkerKind) ~get:fst
+ model
in
let () =
- States.column ~model
+ States.column
~name:"name"
~descr:(Md.plain "Marker short name")
- ~data:(module Jstring)
+ ~data:(module Jalpha)
~get:(fun (tag, _) -> Printer_tag.label tag)
- ()
+ model
in
let () =
- States.column ~model
+ States.column
~name:"descr"
~descr:(Md.plain "Marker declaration or description")
~data:(module Jstring)
~get:(fun (tag, _) -> Rich_text.to_string Printer_tag.pretty tag)
- ()
+ model
in
States.register_array
- ~page
- ~name:"kernel.ast.markerKind"
- ~descr:(Md.plain "Kind of markers")
+ ~package
+ ~name:"markerInfo"
+ ~descr:(Md.plain "Marker informations")
~key:snd
- ~iter
- model
+ ~iter model
let create_tag = function
| PStmt(_,s) -> Printf.sprintf "#s%d" s.sid
@@ -192,10 +172,22 @@ struct
let lookup tag = Hashtbl.find (STATE.get()).locs tag
type t = localizable
- let syntax = Sy.publish ~page:Data.page ~name:"marker"
- ~synopsis:Sy.ident
- ~descr:(Md.plain "Localizable AST marker \
- (function, globals, statements, properties, etc.)") ()
+
+ let markers = ref []
+ let jmarker kd =
+ let jt = Pkg.Jkey kd in markers := jt :: !markers ; jt
+
+ let jstmt = jmarker "stmt"
+ let jdecl = jmarker "decl"
+ let jlval = jmarker "lval"
+ let jexpr = jmarker "expr"
+ let jterm = jmarker "term"
+ let jglobal = jmarker "global"
+ let jproperty = jmarker "property"
+
+ let jtype = Data.declare ~package ~name:"marker"
+ ~descr:(Md.plain "Localizable AST markers")
+ Pkg.(Junion (List.rev !markers))
let to_json loc = `String (create loc)
let of_json js =
@@ -210,54 +202,60 @@ module Printer = Printer_tag.Make(Marker)
(* --- Ast Data --- *)
(* -------------------------------------------------------------------------- *)
-module Stmt = Data.Collection
- (struct
- type t = stmt
- let syntax = Sy.publish ~page:Data.page ~name:"stmt"
- ~synopsis:Sy.ident
- ~descr:(Md.plain "Code statement identifier") ()
- let to_json st =
- let kf = Kernel_function.find_englobing_kf st in
- Marker.to_json (PStmt(kf,st))
- let of_json js =
- let open Printer_tag in
- match Marker.of_json js with
- | PStmt(_,st) | PStmtStart(_,st) -> st
- | _ -> Data.failure "not a stmt marker"
- end)
-
-module Ki = Data.Collection
- (struct
- type t = kinstr
- let syntax = Sy.union [ Sy.tag "global" ; Stmt.syntax ]
- let to_json = function
- | Kglobal -> `String "global"
- | Kstmt st -> Stmt.to_json st
- let of_json = function
- | `String "global" -> Kglobal
- | js -> Kstmt (Stmt.of_json js)
- end)
-
-module Kf = Data.Collection
- (struct
- type t = kernel_function
- let syntax = Sy.publish ~page:Data.page ~name:"fct-id"
- ~synopsis:Sy.ident
- ~descr:(Md.plain "Function identified by its global name.") ()
- let to_json kf =
- `String (Kernel_function.get_name kf)
- let of_json js =
- let key = Js.to_string js in
- try Globals.Functions.find_by_name key
- with Not_found -> Data.failure "Undefined function '%s'" key
- end)
+module Stmt =
+struct
+ type t = stmt
+ let jtype = Marker.jstmt
+ let to_json st =
+ let kf = Kernel_function.find_englobing_kf st in
+ Marker.to_json (PStmt(kf,st))
+ let of_json js =
+ let open Printer_tag in
+ match Marker.of_json js with
+ | PStmt(_,st) | PStmtStart(_,st) -> st
+ | _ -> Data.failure "not a stmt marker"
+end
+
+module Ki =
+struct
+ type t = kinstr
+ let jtype = Pkg.Joption Marker.jstmt
+ let to_json = function
+ | Kglobal -> `Null
+ | Kstmt st -> Stmt.to_json st
+ let of_json = function
+ | `Null -> Kglobal
+ | js -> Kstmt (Stmt.of_json js)
+end
+
+module Kf =
+struct
+ type t = kernel_function
+ let jtype = Pkg.Jkey "fct"
+ let to_json kf =
+ `String (Kernel_function.get_name kf)
+ let of_json js =
+ let key = Js.to_string js in
+ try Globals.Functions.find_by_name key
+ with Not_found -> Data.failure "Undefined function '%s'" key
+end
(* -------------------------------------------------------------------------- *)
(* --- Functions --- *)
(* -------------------------------------------------------------------------- *)
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.ast.printFunction"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getFunctions"
+ ~descr:(Md.plain "Collect all functions in the AST")
+ ~input:(module Junit) ~output:(module Jlist(Kf))
+ begin fun () ->
+ let pool = ref [] in
+ Globals.Functions.iter (fun kf -> pool := kf :: !pool) ;
+ List.rev !pool
+ end
+
+let () = Request.register ~package
+ ~kind:`GET ~name:"printFunction"
~descr:(Md.plain "Print the AST of a function")
~input:(module Kf) ~output:(module Jtext)
(fun kf -> Jbuffer.to_json Printer.pp_global (Kernel_function.get_global kf))
@@ -274,24 +272,22 @@ struct
let array : kernel_function States.array =
begin
let model = States.model () in
- States.column ~model
+ States.column model
~name:"name"
~descr:(Md.plain "Name")
- ~data:(module Data.Jstring)
- ~get:Kernel_function.get_name () ;
- States.column ~model
+ ~data:(module Data.Jalpha)
+ ~get:Kernel_function.get_name ;
+ States.column model
~name:"signature"
~descr:(Md.plain "Signature")
~data:(module Data.Jstring)
- ~get:signature
- () ;
- States.register_array
- ~page ~key
- ~name:"kernel.ast.functions"
+ ~get:signature ;
+ States.register_array model
+ ~package ~key
+ ~name:"functions"
~descr:(Md.plain "AST Functions")
~iter:Globals.Functions.iter
- ~add_reload_hook:Ast.add_hook_on_update
- model
+ ~add_reload_hook:Ast.add_hook_on_update ;
end
end
@@ -360,8 +356,8 @@ module Info = struct
Jbuffer.contents buffer
end
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.ast.info"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getInfo"
~descr:(Md.plain "Get textual information about a marker")
~input:(module Marker) ~output:(module Jtext)
Info.get_marker_info
@@ -376,11 +372,11 @@ let get_files () =
let () =
Request.register
- ~page
+ ~package
~descr:(Md.plain "Get the currently analyzed source file names")
~kind:`GET
- ~name:"kernel.ast.getFiles"
- ~input:(module Junit) ~output:(module Jstring.Jlist)
+ ~name:"getFiles"
+ ~input:(module Junit) ~output:(module Jlist(Jstring))
get_files
let set_files files =
@@ -389,24 +385,12 @@ let set_files files =
let () =
Request.register
- ~page
+ ~package
~descr:(Md.plain "Set the source file names to analyze.")
~kind:`SET
- ~name:"kernel.ast.setFiles"
- ~input:(module Jstring.Jlist)
+ ~name:"setFiles"
+ ~input:(module Jlist(Jstring))
~output:(module Junit)
set_files
-let () =
- Request.register
- ~page
- ~descr:(Md.plain "Compute the AST of the currently set source file names.")
- ~kind:`EXEC
- ~name:"kernel.ast.execCompute"
- ~input:(module Junit)
- ~output:(module Junit)
- (fun () ->
- if not (Ast.is_computed ())
- then File.init_from_cmdline ())
-
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/kernel_ast.mli b/src/plugins/server/kernel_ast.mli
index 79b5a4eee57680f9742600547641add4e97b34f1..c0d3d0ff73090d3c5c7d839b3494ba4fe4dbe259 100644
--- a/src/plugins/server/kernel_ast.mli
+++ b/src/plugins/server/kernel_ast.mli
@@ -24,15 +24,25 @@
(** Ast Data *)
(* -------------------------------------------------------------------------- *)
+open Package
open Cil_types
-module Kf : Data.S_collection with type t = kernel_function
-module Ki : Data.S_collection with type t = kinstr
-module Stmt : Data.S_collection with type t = stmt
+module Kf : Data.S with type t = kernel_function
+module Ki : Data.S with type t = kinstr
+module Stmt : Data.S with type t = stmt
module Marker :
sig
include Data.S with type t = Printer_tag.localizable
+
+ val jstmt : jtype
+ val jdecl : jtype
+ val jlval : jtype
+ val jexpr : jtype
+ val jterm : jtype
+ val jglobal : jtype
+ val jproperty : jtype
+
val create : t -> string (** Memoized unique identifier. *)
val lookup : string -> t (** Get back the localizable, if any. *)
end
diff --git a/src/plugins/server/kernel_main.ml b/src/plugins/server/kernel_main.ml
index f5d1a35dc1628a0bbf023e7d47e112e9c7da6e87..e3c92e75a42f4a775c52c41233fe388559f4dfe2 100644
--- a/src/plugins/server/kernel_main.ml
+++ b/src/plugins/server/kernel_main.ml
@@ -21,34 +21,36 @@
(**************************************************************************)
open Data
-module Sy = Syntax
module Md = Markdown
+module Pkg = Package
module Senv = Server_parameters
(* -------------------------------------------------------------------------- *)
(* --- Frama-C Kernel Services --- *)
(* -------------------------------------------------------------------------- *)
-let page = Doc.page `Kernel ~title:"Kernel Services" ~filename:"kernel.md"
+let package = Pkg.package ~name:"services"
+ ~title:"Kernel Services" ~readme:"kernel.md" ()
(* -------------------------------------------------------------------------- *)
(* --- Config --- *)
(* -------------------------------------------------------------------------- *)
let () =
- let get_config = Request.signature
- ~page ~kind:`GET ~name:"kernel.getConfig"
- ~descr:(Md.plain "Frama-C Kernel configuration")
- ~input:(module Junit) () in
+ let signature = Request.signature ~input:(module Junit) () in
let result name descr =
- Request.result get_config ~name ~descr:(Md.plain descr) (module Jstring) in
+ Request.result signature ~name ~descr:(Md.plain descr) (module Jstring) in
let set_version = result "version" "Frama-C version" in
let set_datadir = result "datadir" "Shared directory (FRAMAC_SHARE)" in
let set_libdir = result "libdir" "Lib directory (FRAMAC_LIB)" in
- let set_pluginpath = Request.result get_config
- ~name:"pluginpath" ~descr:(Md.plain "Plugin directories (FRAMAC_PLUGIN)")
- (module Jstring.Jlist) in
- Request.register_sig get_config
+ let set_pluginpath = Request.result signature
+ ~name:"pluginpath"
+ ~descr:(Md.plain "Plugin directories (FRAMAC_PLUGIN)")
+ (module Jlist(Jstring)) in
+ Request.register_sig
+ ~package ~kind:`GET ~name:"getConfig"
+ ~descr:(Md.plain "Frama-C Kernel configuration")
+ signature
begin fun rq () ->
set_version rq Fc_config.version ;
set_datadir rq Fc_config.datadir ;
@@ -61,145 +63,142 @@ let () =
(* -------------------------------------------------------------------------- *)
let () =
- let signature =
- Request.signature ~page ~kind:`SET ~name:"kernel.load"
- ~descr:(Md.plain "Load a save file")
- ~input:(module Jstring)
- ~output:(module Jstring.Joption)
- ()
- in
- let load _rq file =
- try Project.load_all (Filepath.Normalized.of_string file); None
- with Project.IOError err -> Some err
- in
- Request.register_sig signature load
+ Request.register ~package ~kind:`SET ~name:"load"
+ ~descr:(Md.plain "Load a save file. Returns an error, if not successfull.")
+ ~input:(module Jstring)
+ ~output:(module Joption(Jstring))
+ (fun file ->
+ try Project.load_all (Filepath.Normalized.of_string file); None
+ with Project.IOError err -> Some err)
(* -------------------------------------------------------------------------- *)
(* --- File Positions --- *)
(* -------------------------------------------------------------------------- *)
-module LogSource = Collection
- (struct
- type t = Filepath.position
-
- let synopsis =
- Sy.record [ "dir", Sy.string; "base", Sy.string;
- "file", Sy.string; "line", Sy.int ]
-
- let syntax = Sy.publish ~page:Data.page ~name:"source" ~synopsis
- ~descr:(Md.plain "Source file positions.")
- ~details:Md.([Block [Text (plain "The file path is normalized, \
- and the line number starts at one.")]])
- ()
-
- let to_json p =
- let path = Filepath.(Normalized.to_pretty_string p.pos_path) in
- `Assoc [
- "dir" , `String (Filename.dirname path) ;
- "base" , `String (Filename.basename path) ;
- "file" , `String (p.Filepath.pos_path :> string) ;
- "line" , `Int p.Filepath.pos_lnum ;
- ]
-
- let of_json js =
- let fail () = failure_from_type_error "Invalid source format" js in
- match js with
- | `Assoc assoc ->
- begin
- match List.assoc "file" assoc, List.assoc "line" assoc with
- | `String path, `Int line ->
- Log.source ~file:(Filepath.Normalized.of_string path) ~line
- | _, _ -> fail ()
- | exception Not_found -> fail ()
- end
- | _ -> fail ()
-
- end)
+module LogSource =
+struct
+ type t = Filepath.position
+
+ let jtype = Data.declare ~package ~name:"source"
+ ~descr:(Md.plain "Source file positions.")
+ (Jrecord [
+ "dir", Jstring;
+ "base", Jstring;
+ "file", Jstring;
+ "line", Jnumber;
+ ])
+
+ let to_json p =
+ let path = Filepath.(Normalized.to_pretty_string p.pos_path) in
+ `Assoc [
+ "dir" , `String (Filename.dirname path) ;
+ "base" , `String (Filename.basename path) ;
+ "file" , `String (p.Filepath.pos_path :> string) ;
+ "line" , `Int p.Filepath.pos_lnum ;
+ ]
+
+ let of_json js =
+ let fail () = failure_from_type_error "Invalid source format" js in
+ match js with
+ | `Assoc assoc ->
+ begin
+ match List.assoc "file" assoc, List.assoc "line" assoc with
+ | `String path, `Int line ->
+ Log.source ~file:(Filepath.Normalized.of_string path) ~line
+ | _, _ -> fail ()
+ | exception Not_found -> fail ()
+ end
+ | _ -> fail ()
+
+end
(* -------------------------------------------------------------------------- *)
(* --- Log Lind --- *)
(* -------------------------------------------------------------------------- *)
-module LogKind = Collection
- (struct
+module LogKind =
+struct
+ let kinds = Enum.dictionary ()
- let kinds = Enum.dictionary ~page
- ~name:"logkind" ~title:"Log Kind"
- ~descr:(Md.plain "Frama-C message category.")
- ()
+ let t_kind value name descr =
+ Enum.tag ~name ~descr:(Md.plain descr) ~value kinds
- let t_kind value name descr =
- Enum.tag kinds ~name ~descr:(Md.plain descr) ~value ()
+ let t_error = t_kind Log.Error "ERROR" "User Error"
+ let t_warning = t_kind Log.Warning "WARNING" "User Warning"
+ let t_feedback = t_kind Log.Feedback "FEEDBACK" "Plugin Feedback"
+ let t_result = t_kind Log.Result "RESULT" "Plugin Result"
+ let t_failure = t_kind Log.Failure "FAILURE" "Plugin Failure"
+ let t_debug = t_kind Log.Debug "DEBUG" "Analyser Debug"
- let t_error = t_kind Log.Error "ERROR" "User Error"
- let t_warning = t_kind Log.Warning "WARNING" "User Warning"
- let t_feedback = t_kind Log.Feedback "FEEDBACK" "Plugin Feedback"
- let t_result = t_kind Log.Result "RESULT" "Plugin Result"
- let t_failure = t_kind Log.Failure "FAILURE" "Plugin Failure"
- let t_debug = t_kind Log.Debug "DEBUG" "Analyser Debug"
-
- let tag = function
+ let () = Enum.set_lookup kinds
+ begin function
| Log.Error -> t_error
| Log.Warning -> t_warning
| Log.Feedback -> t_feedback
| Log.Result -> t_result
| Log.Failure -> t_failure
| Log.Debug -> t_debug
+ end
- let data = Enum.publish kinds ~tag ()
- let () = Request.dictionary kinds
+ let data = Request.dictionary ~package
+ ~name:"logkind"
+ ~descr:(Md.plain "Log messages categories.")
+ kinds
- include (val data : S with type t = Log.kind)
- end)
+ include (val data : S with type t = Log.kind)
+end
(* -------------------------------------------------------------------------- *)
(* --- Log Events --- *)
(* -------------------------------------------------------------------------- *)
-module LogEvent = Collection
- (struct
-
- type rlog
-
- let jlog : rlog Record.signature = Record.signature ~page
- ~name:"log" ~descr:(Md.plain "Message event record.") ()
-
- let kind = Record.field jlog ~name:"kind"
- ~descr:(Md.plain "Message kind") (module LogKind)
- let plugin = Record.field jlog ~name:"plugin"
- ~descr:(Md.plain "Emitter plugin") (module Jstring)
- let message = Record.field jlog ~name:"message"
- ~descr:(Md.plain "Message text") (module Jstring)
- let category = Record.option jlog ~name:"category"
- ~descr:(Md.plain "Message category (DEBUG or WARNING)") (module Jstring)
- let source = Record.option jlog ~name:"source"
- ~descr:(Md.plain "Source file position") (module LogSource)
-
- module R = (val (Record.publish jlog) : Record.S with type r = rlog)
-
- type t = Log.event
- let syntax = R.syntax
-
- let to_json evt =
- R.default |>
- R.set plugin evt.Log.evt_plugin |>
- R.set kind evt.Log.evt_kind |>
- R.set category evt.Log.evt_category |>
- R.set source evt.Log.evt_source |>
- R.set message evt.Log.evt_message |>
- R.to_json
-
- let of_json js =
- let r = R.of_json js in
- {
- Log.evt_plugin = R.get plugin r ;
- Log.evt_kind = R.get kind r ;
- Log.evt_category = R.get category r ;
- Log.evt_source = R.get source r ;
- Log.evt_message = R.get message r ;
- }
-
- end)
+module LogEvent =
+struct
+
+ type rlog
+
+ let jlog : rlog Record.signature = Record.signature ()
+
+ let kind = Record.field jlog ~name:"kind"
+ ~descr:(Md.plain "Message kind") (module LogKind)
+ let plugin = Record.field jlog ~name:"plugin"
+ ~descr:(Md.plain "Emitter plugin") (module Jalpha)
+ let message = Record.field jlog ~name:"message"
+ ~descr:(Md.plain "Message text") (module Jstring)
+ let category = Record.option jlog ~name:"category"
+ ~descr:(Md.plain "Message category (DEBUG or WARNING)") (module Jstring)
+ let source = Record.option jlog ~name:"source"
+ ~descr:(Md.plain "Source file position") (module LogSource)
+
+ let data = Record.publish ~package ~name:"log"
+ ~descr:(Md.plain "Message event record.") jlog
+
+ module R : Record.S with type r = rlog = (val data)
+
+ type t = Log.event
+
+ let jtype = R.jtype
+
+ let to_json evt =
+ R.default |>
+ R.set plugin evt.Log.evt_plugin |>
+ R.set kind evt.Log.evt_kind |>
+ R.set category evt.Log.evt_category |>
+ R.set source evt.Log.evt_source |>
+ R.set message evt.Log.evt_message |>
+ R.to_json
+
+ let of_json js =
+ let r = R.of_json js in
+ {
+ Log.evt_plugin = R.get plugin r ;
+ Log.evt_kind = R.get kind r ;
+ Log.evt_category = R.get category r ;
+ Log.evt_source = R.get source r ;
+ Log.evt_message = R.get message r ;
+ }
+
+end
(* -------------------------------------------------------------------------- *)
(* --- Log Monitoring --- *)
@@ -236,16 +235,18 @@ let () =
(* --- Log Requests --- *)
(* -------------------------------------------------------------------------- *)
+(* TODO:LC: shall have an array here. *)
+
let () = Request.register
- ~page ~kind:`SET ~name:"kernel.setLogs"
+ ~package ~kind:`SET ~name:"setLogs"
~descr:(Md.plain "Turn logs monitoring on/off")
~input:(module Jbool) ~output:(module Junit)
set_monitoring
let () = Request.register
- ~page ~kind:`GET ~name:"kernel.getLogs"
+ ~package ~kind:`GET ~name:"getLogs"
~descr:(Md.plain "Flush the last emitted logs since last call (max 100)")
- ~input:(module Junit) ~output:(module LogEvent.Jlist)
+ ~input:(module Junit) ~output:(module Jlist(LogEvent))
begin fun () ->
let pool = ref [] in
let count = ref 100 in
diff --git a/src/plugins/server/kernel_main.mli b/src/plugins/server/kernel_main.mli
index 24d6ec8ec7e76a152aef3c477ea5a8f9b8d85c50..112dc65beff3aaf8745f5a074e318e99dae505ad 100644
--- a/src/plugins/server/kernel_main.mli
+++ b/src/plugins/server/kernel_main.mli
@@ -24,7 +24,7 @@
(** Kernel Services *)
(* -------------------------------------------------------------------------- *)
-module LogSource : Data.S_collection with type t = Filepath.position
-module LogEvent : Data.S_collection with type t = Log.event
+module LogSource : Data.S with type t = Filepath.position
+module LogEvent : Data.S with type t = Log.event
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/kernel_project.ml b/src/plugins/server/kernel_project.ml
index b65a1c577ff6642a331a3faec9afc741871724f5..3dcc1454374bcd3d1176d1ae15eb708683372888 100644
--- a/src/plugins/server/kernel_project.ml
+++ b/src/plugins/server/kernel_project.ml
@@ -21,36 +21,41 @@
(**************************************************************************)
open Data
-module Sy = Syntax
module Md = Markdown
module Js = Yojson.Basic.Util
+module Pkg = Package
-let page = Doc.page `Kernel ~title:"Project Management" ~filename:"project.md"
+let package = Pkg.package ~name:"project"
+ ~title:"Project Management" ~readme:"project.md" ()
(* -------------------------------------------------------------------------- *)
(* --- Project Info --- *)
(* -------------------------------------------------------------------------- *)
+module ProjectId = (val jkey ~kind:"project")
+
module ProjectInfo =
- Collection
- (struct
- type t = Project.t
-
- let syntax = Sy.publish ~page ~name:"project-info"
- ~descr:(Md.plain "Project informations")
- ~synopsis:Sy.(record[ "id",ident; "name",string; "current",boolean ])
- ()
-
- let of_json js =
- Js.member "id" js |> Js.to_string |> Project.from_unique_name
-
- let to_json p =
- `Assoc [
- "id", `String (Project.get_unique_name p) ;
- "name", `String (Project.get_name p) ;
- "current", `Bool (Project.is_current p) ;
- ]
- end)
+struct
+ type t = Project.t
+ let jtype = Data.declare ~package
+ ~name:"projectInfo"
+ ~descr:(Md.plain "Project informations")
+ Pkg.(Jrecord [
+ "id",ProjectId.jtype;
+ "name",Jalpha;
+ "current",Jboolean;
+ ])
+
+ let of_json js =
+ Js.member "id" js |> Js.to_string |> Project.from_unique_name
+
+ let to_json p =
+ `Assoc [
+ "id", `String (Project.get_unique_name p) ;
+ "name", `String (Project.get_name p) ;
+ "current", `Bool (Project.is_current p) ;
+ ]
+end
(* -------------------------------------------------------------------------- *)
(* --- Project Requests --- *)
@@ -59,11 +64,17 @@ module ProjectInfo =
module ProjectRequest =
struct
+ (* forward request on a given project *)
+
type t = Project.t * string * json
- let syntax = Sy.publish ~page ~name:"project-request"
- ~synopsis:(Sy.(record[ "project",ident; "request",string; "data",any; ]))
- ~descr:(Md.plain "Request to be executed on the specified project.") ()
+ let jtype = Data.declare ~package ~name:"projectRequest"
+ ~descr:(Md.plain "Request to be executed on the specified project.")
+ (Jrecord [
+ "project",ProjectId.jtype;
+ "request",Jstring;
+ "data",Jany;
+ ])
let of_json js =
begin
@@ -84,38 +95,38 @@ end
(* --- Project Requests --- *)
(* -------------------------------------------------------------------------- *)
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.project.getCurrent"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getCurrent"
~descr:(Md.plain "Returns the current project")
~input:(module Junit) ~output:(module ProjectInfo)
Project.current
-let () = Request.register ~page
- ~kind:`SET ~name:"kernel.project.setCurrent"
+let () = Request.register ~package
+ ~kind:`SET ~name:"setCurrent"
~descr:(Md.plain "Switches the current project")
- ~input:(module Jident) ~output:(module Junit)
+ ~input:(module ProjectId) ~output:(module Junit)
(fun pid -> Project.(set_current (from_unique_name pid)))
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.project.getList"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getList"
~descr:(Md.plain "Returns the list of all projects")
- ~input:(module Junit) ~output:(module ProjectInfo.Jlist)
+ ~input:(module Junit) ~output:(module Jlist(ProjectInfo))
(fun () -> Project.fold_on_projects (fun ids p -> p :: ids) [])
-let () = Request.register ~page
- ~kind:`GET ~name:"kernel.project.getOn"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getOn"
~descr:(Md.plain "Execute a GET request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
(ProjectRequest.process `GET)
-let () = Request.register ~page
- ~kind:`SET ~name:"kernel.project.setOn"
+let () = Request.register ~package
+ ~kind:`SET ~name:"setOn"
~descr:(Md.plain "Execute a SET request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
(ProjectRequest.process `SET)
-let () = Request.register ~page
- ~kind:`EXEC ~name:"kernel.project.execOn"
+let () = Request.register ~package
+ ~kind:`EXEC ~name:"execOn"
~descr:(Md.plain "Execute an EXEC request within the given project")
~input:(module ProjectRequest) ~output:(module Jany)
(ProjectRequest.process `EXEC)
@@ -126,10 +137,10 @@ let () = Request.register ~page
let () =
Request.register
- ~page
+ ~package
~descr:(Md.plain "Create a new project")
~kind:`SET
- ~name:"kernel.project.setCreate"
+ ~name:"create"
~input:(module Jstring)
~output:(module ProjectInfo)
Project.create
diff --git a/src/plugins/server/kernel_properties.ml b/src/plugins/server/kernel_properties.ml
index 81314f52acbd63acf5a38cbc20424a4a816d560b..ef20336fc6af9a5cce418d9e9c50a068dd85c7fa 100644
--- a/src/plugins/server/kernel_properties.ml
+++ b/src/plugins/server/kernel_properties.ml
@@ -21,12 +21,13 @@
(**************************************************************************)
module Md = Markdown
+module Pkg = Package
open Data
open Kernel_main
open Kernel_ast
-let page = Doc.page `Kernel ~title:"Property Services" ~filename:"properties.md"
+let package = Pkg.package ~title:"Property Services" ~name:"properties" ()
(* -------------------------------------------------------------------------- *)
(* --- Property Kind --- *)
@@ -34,16 +35,16 @@ let page = Doc.page `Kernel ~title:"Property Services" ~filename:"properties.md"
module PropKind =
struct
- let kinds = Enum.dictionary ~page
- ~name:"propkind" ~title:"Kind"
- ~descr:(Md.plain "Property Kind")
- ()
+ let kinds = Enum.dictionary ()
let t_kind name descr =
- Enum.tag kinds ~name ~label:(Md.plain name) ~descr:(Md.plain descr) ()
- let t_clause name = t_kind name (Printf.sprintf "Clause `@%s`" name)
+ Enum.tag ~name ~label:(Md.plain name) ~descr:(Md.plain descr) kinds
+
+ let t_clause name =
+ t_kind name (Printf.sprintf "Clause `@%s`" name)
+
let t_loop name =
- t_kind ("loop-" ^ name) (Printf.sprintf "Clause `@loop %s`" name)
+ t_kind ("loop_" ^ name) (Printf.sprintf "Clause `@loop %s`" name)
let t_behavior = t_kind "behavior" "Contract behavior"
let t_complete = t_kind "complete" "Complete behaviors clause"
@@ -65,34 +66,34 @@ struct
let t_assert = t_kind "assert" "Assertion"
let t_check = t_kind "check" "Check"
- let t_loop_invariant = t_kind "invariant" "Loop invariant"
+ let t_loop_invariant = t_loop "invariant"
let t_loop_assigns = t_loop "assigns"
- let t_loop_variant = t_kind "variant" "Loop termination argument"
+ let t_loop_variant = t_loop "variant"
let t_loop_allocates = t_loop "allocates"
let t_loop_pragma = t_loop "pragma"
let t_reachable = t_kind "reachable" "Reachable statement"
- let t_code_contract = t_kind "code-contract" "Statement contract"
- let t_code_invariant = t_kind "code-invariant" "Generalized loop invariant"
- let t_type_invariant = t_kind "type-invariant" "Type invariant"
- let t_global_invariant = t_kind "global-invariant" "Global invariant"
+ let t_code_contract = t_kind "code_contract" "Statement contract"
+ let t_code_invariant = t_kind "code_invariant" "Generalized loop invariant"
+ let t_type_invariant = t_kind "type_invariant" "Type invariant"
+ let t_global_invariant = t_kind "global_invariant" "Global invariant"
let t_axiomatic = t_kind "axiomatic" "Axiomatic definitions"
let t_axiom = t_kind "axiom" "Logical axiom"
let t_lemma = t_kind "lemma" "Logical lemma"
- let p_ext = Enum.prefix kinds ~prefix:"ext" ~var:"<clause>"
- ~descr:(Md.plain "ACSL extension `<clause>`") ()
+ let p_ext = Enum.prefix kinds ~name:"ext" ~var:"<clause>"
+ ~descr:(Md.plain "ACSL extension `<clause>`")
- let p_loop_ext = Enum.prefix kinds ~prefix:"loop-ext" ~var:"<clause>"
- ~descr:(Md.plain "ACSL loop extension `loop <clause>`") ()
+ let p_loop_ext = Enum.prefix kinds ~name:"loop_ext" ~var:"<clause>"
+ ~descr:(Md.plain "ACSL loop extension `loop <clause>`")
- let p_other = Enum.prefix kinds ~prefix:"prop" ~var:"<prop>"
- ~descr:(Md.plain "Plugin Specific properties") ()
+ let p_other = Enum.prefix kinds ~name:"prop" ~var:"<prop>"
+ ~descr:(Md.plain "Plugin Specific properties")
open Property
- let tag = function
+ let lookup = function
| IPPredicate { ip_kind } ->
begin match ip_kind with
| PKRequires _ -> t_requires
@@ -134,8 +135,11 @@ struct
| IPGlobalInvariant _ -> t_global_invariant
| IPOther { io_name } -> Enum.instance p_other io_name
- let data = Enum.publish kinds ~tag ()
- let () = Request.dictionary kinds
+ let () = Enum.set_lookup kinds lookup
+ let data = Request.dictionary ~package
+ ~name:"propKind"
+ ~descr:(Md.plain "Property Kinds")
+ kinds
include (val data : S with type t = Property.t)
end
@@ -146,7 +150,7 @@ let register_propkind ~name ~kind ?label ~descr () =
| `Clause -> p_ext
| `Loop -> p_loop_ext
| `Other -> p_other
- in ignore @@ Enum.extends kinds prefix ~name ?label ~descr ()
+ in ignore @@ Enum.extends prefix ~name ?label ~descr
(* -------------------------------------------------------------------------- *)
(* --- Property Status --- *)
@@ -155,14 +159,12 @@ let register_propkind ~name ~kind ?label ~descr () =
module PropStatus =
struct
- let status = Enum.dictionary ~page
- ~name:"propstatus" ~title:"Status"
- ~descr:(Md.plain "Property Status (consolidated)") ()
+ let status = Enum.dictionary ()
let t_status value name ?label descr =
- Enum.tag status ~name
+ Enum.tag ~name
?label:(Extlib.opt_map Md.plain label)
- ~descr:(Md.plain descr) ~value ()
+ ~descr:(Md.plain descr) ~value status
open Property_status.Feedback
@@ -196,21 +198,23 @@ struct
t_status Unknown_but_dead "unknown_but_dead"
~label:"Unknown (âœ)" "Dead property (but unknown)"
- let tag = function
- | Valid -> t_valid
- | Invalid -> t_invalid
- | Unknown -> t_unknown
- | Never_tried -> t_never_tried
- | Valid_under_hyp -> t_valid_under_hyp
- | Valid_but_dead -> t_valid_but_dead
- | Considered_valid -> t_considered_valid
- | Invalid_under_hyp -> t_invalid_under_hyp
- | Invalid_but_dead -> t_invalid_but_dead
- | Unknown_but_dead -> t_unknown_but_dead
- | Inconsistent -> t_inconsistent
-
- let data = Enum.publish status ~tag ()
- let () = Request.dictionary status
+ let () = Enum.set_lookup status
+ begin function
+ | Valid -> t_valid
+ | Invalid -> t_invalid
+ | Unknown -> t_unknown
+ | Never_tried -> t_never_tried
+ | Valid_under_hyp -> t_valid_under_hyp
+ | Valid_but_dead -> t_valid_but_dead
+ | Considered_valid -> t_considered_valid
+ | Invalid_under_hyp -> t_invalid_under_hyp
+ | Invalid_but_dead -> t_invalid_but_dead
+ | Unknown_but_dead -> t_unknown_but_dead
+ | Inconsistent -> t_inconsistent
+ end
+
+ let data = Request.dictionary ~package ~name:"propStatus"
+ ~descr:(Md.plain "Property Status (consolidated)") status
include (val data : S with type t = Property_status.Feedback.t)
end
@@ -219,27 +223,33 @@ end
(* --- Alarm kind --- *)
(* -------------------------------------------------------------------------- *)
-module AlarmKind = struct
- let alarms = Enum.dictionary ~page ~name:"alarmkind" ~title:"Alarm kind"
- ~descr:(Md.plain "Alarm kind") ()
+[@@@ warning "-60"]
+module AlarmKind =
+struct
+
+ let alarms = Enum.dictionary ()
let register alarm =
let name = Alarms.get_short_name alarm in
let label = Md.plain name in
let descr = Md.plain (Alarms.get_description alarm) in
- ignore (Enum.tag alarms ~name ~label ~descr ())
+ Enum.add alarms ~name ~label ~descr
+
let () = List.iter register Alarms.reprs
- let tag alarm =
- let name = Alarms.get_short_name alarm in
- try Enum.find_tag alarms name
- with Not_found -> failure "Unknown alarm kind: %s" name
+ let () = Enum.set_lookup alarms
+ begin function alarm ->
+ let name = Alarms.get_short_name alarm in
+ try Enum.find_tag alarms name
+ with Not_found -> failure "Unknown alarm kind: %s" name
+ end
- let data = Enum.publish alarms ~tag ()
- let () = Request.dictionary alarms
+ let data = Request.dictionary
+ ~package ~name:"alarms" ~descr:(Md.plain "Alarm Kinds") alarms
include (val data : S with type t = Alarms.t)
end
+[@@@ warning "+60"]
(* -------------------------------------------------------------------------- *)
(* --- Property Model --- *)
@@ -251,49 +261,53 @@ let find_alarm = function
let model = States.model ()
-let () = States.column ~model ~name:"descr"
+let () = States.column model ~name:"descr"
~descr:(Md.plain "Full description")
~data:(module Jstring)
- ~get:(fun ip -> Format.asprintf "%a" Property.pretty ip) ()
+ ~get:(fun ip -> Format.asprintf "%a" Property.pretty ip)
-let () = States.column ~model ~name:"kind"
+let () = States.column model ~name:"kind"
~descr:(Md.plain "Kind")
~data:(module PropKind)
- ~get:(fun ip -> ip) ()
+ ~get:(fun ip -> ip)
-let () = States.column ~model ~name:"names"
+let () = States.column model ~name:"names"
~descr:(Md.plain "Names")
- ~data:(module Jstring.Jlist)
- ~get:Property.get_names ()
+ ~data:(module Jlist(Jstring))
+ ~get:Property.get_names
-let () = States.column ~model ~name:"status"
+let () = States.column model ~name:"status"
~descr:(Md.plain "Status")
~data:(module PropStatus)
- ~get:(Property_status.Feedback.get) ()
+ ~get:(Property_status.Feedback.get)
-let () = States.column ~model ~name:"function"
+let () = States.column model ~name:"function"
~descr:(Md.plain "Function")
- ~data:(module Kf.Joption) ~get:Property.get_kf ()
+ ~data:(module Joption(Kf)) ~get:Property.get_kf
-let () = States.column ~model ~name:"kinstr"
+let () = States.column model ~name:"kinstr"
~descr:(Md.plain "Instruction")
- ~data:(module Ki) ~get:Property.get_kinstr ()
+ ~data:(module Ki) ~get:Property.get_kinstr
-let () = States.column ~model ~name:"source"
+let () = States.column model ~name:"source"
~descr:(Md.plain "Position")
~data:(module LogSource)
- ~get:(fun ip -> Property.location ip |> fst) ()
+ ~get:(fun ip -> Property.location ip |> fst)
+
+let () = States.column model ~name:"alarm"
+ ~descr:(Md.plain "Alarm name (if the property is an alarm)")
+ ~data:(module Joption(Jstring))
+ ~get:(fun ip -> Extlib.opt_map Alarms.get_short_name (find_alarm ip))
-let () = States.column ~model ~name:"alarm"
- ~descr:(Md.plain "Alarm kind (if the property is an alarm)")
- ~data:(module Data.Joption (AlarmKind))
- ~get:find_alarm ()
+let () = States.column model ~name:"alarm_descr"
+ ~descr:(Md.plain "Alarm description (if the property is an alarm)")
+ ~data:(module Joption(Jstring))
+ ~get:(fun ip -> Extlib.opt_map Alarms.get_description (find_alarm ip))
-let () = States.column ~model ~name:"predicate"
+let () = States.column model ~name:"predicate"
~descr:(Md.plain "Predicate")
- ~data:(module Jstring.Joption)
+ ~data:(module Joption(Jstring))
~get:(fun ip -> Extlib.opt_map snd (Description.property_kind_and_node ip))
- ()
let is_relevant ip =
match Property.get_kf ip with
@@ -312,9 +326,9 @@ let add_remove_hook f =
let array =
States.register_array
- ~page
- ~name:"kernel.properties"
- ~descr:(Md.plain "Registered Properties")
+ ~package
+ ~name:"status"
+ ~descr:(Md.plain "Status of Registered Properties")
~key:(fun ip -> Kernel_ast.Marker.create (PIP ip))
~iter
~add_update_hook
diff --git a/src/plugins/server/package.ml b/src/plugins/server/package.ml
new file mode 100644
index 0000000000000000000000000000000000000000..6f2e56f956b5cafbb98573b3d8712d95206ed9d6
--- /dev/null
+++ b/src/plugins/server/package.ml
@@ -0,0 +1,542 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+
+module Senv = Server_parameters
+module Md = Markdown
+
+(* -------------------------------------------------------------------------- *)
+
+type plugin = Kernel | Plugin of string
+type ident = { plugin: plugin; package: string list; name: string }
+
+let pp_step fmt a =
+ ( Format.pp_print_string fmt a ; Format.pp_print_char fmt '.' )
+
+let pp_plugin fmt = function
+ | Kernel -> pp_step fmt "kernel"
+ | Plugin p -> pp_step fmt "plugins" ; pp_step fmt p
+
+let pp_ident fmt { plugin ; package ; name } =
+ ( pp_plugin fmt plugin ;
+ List.iter (pp_step fmt) package ;
+ Format.pp_print_string fmt name )
+
+(* -------------------------------------------------------------------------- *)
+(* --- Name Resolution --- *)
+(* -------------------------------------------------------------------------- *)
+
+module Std = Transitioning.Stdlib
+module Id = struct type t = ident let compare = Std.compare end
+module IdMap = Map.Make(Id)
+module IdSet = Set.Make(Id)
+module NameSet = Set.Make(String)
+
+module Scope =
+struct
+
+ let rec inpkg ids = function
+ | [] -> ids
+ | [p] -> p::ids
+ | _::ps -> inpkg ids ps
+
+ let relative ~source ~target ids =
+ if target = source then ids else
+ match target with
+ | Kernel -> ids
+ | Plugin p -> p::ids
+
+ let target p ids =
+ match p with
+ | Kernel -> "kernel" :: ids
+ | Plugin p -> "plugins" :: p :: ids
+
+ (* propose various abbreviations ; finally render full qualified name *)
+ let ranked source { plugin ; package ; name } k =
+ String.concat "_" @@
+ let name = [name] in
+ match k with
+ | 0 -> name
+ | 1 -> relative ~source ~target:plugin name
+ | 2 -> relative ~source ~target:plugin (inpkg name package)
+ | 3 -> relative ~source ~target:plugin (package @ name)
+ | _ -> target plugin (package @ name)
+
+ type t = {
+ source : plugin ;
+ mutable clashes : bool ;
+ mutable index : (string,int IdMap.t) Hashtbl.t ;
+ mutable names : string IdMap.t ;
+ mutable reserved : NameSet.t ;
+ }
+
+ let create source = {
+ source ;
+ index = Hashtbl.create 0 ;
+ clashes = false ;
+ names = IdMap.empty ;
+ reserved = NameSet.empty ;
+ }
+
+ let rec non_reserved scope id rk =
+ let a = ranked scope.source id rk in
+ if NameSet.mem a scope.reserved then
+ non_reserved scope id (succ rk)
+ else a,rk
+
+ let push scope id rk =
+ begin
+ let name, rk = non_reserved scope id rk in
+ scope.names <- IdMap.add id name scope.names ;
+ let index = scope.index in
+ match Hashtbl.find_opt index name with
+ | None ->
+ Hashtbl.add index name (IdMap.add id rk IdMap.empty)
+ | Some idks ->
+ if IdMap.mem id idks then
+ scope.clashes <- true
+ else
+ Hashtbl.replace index name (IdMap.add id rk idks)
+ end
+
+ let use scope id =
+ if not (IdMap.mem id scope.names) then
+ push scope id 0
+
+ let reserve scope name =
+ assert (IdMap.is_empty scope.names) ;
+ scope.reserved <- NameSet.add name scope.reserved
+
+ let declare scope id =
+ begin
+ let { name } = id in
+ if NameSet.mem name scope.reserved then
+ Senv.fatal "Reserved name for identifier '%a'" pp_ident id ;
+ scope.names <- IdMap.add id name scope.names ;
+ scope.reserved <- NameSet.add name scope.reserved ;
+ end
+
+ let rec resolve scope =
+ if not scope.clashes then scope.names else
+ begin
+ let index = scope.index in
+ scope.index <- Hashtbl.create 0 ;
+ scope.clashes <- false ;
+ Hashtbl.iter
+ (fun _name idks ->
+ match IdMap.bindings idks with
+ | [id,rk] ->
+ push scope id rk
+ | idks ->
+ List.iter (fun (id,rk) -> push scope id (succ rk)) idks
+ ) index ;
+ resolve scope
+ end
+
+end
+
+(* -------------------------------------------------------------------------- *)
+(* --- JSON Datatypes --- *)
+(* -------------------------------------------------------------------------- *)
+
+type jtype =
+ | Jany
+ | Jnull
+ | Jboolean
+ | Jnumber
+ | Jstring
+ | Jalpha (* string primarily compared without case *)
+ | Jkey of string (* kind of a string used for indexing *)
+ | Jindex of string (* kind of an integer used for indexing *)
+ | Joption of jtype
+ | Jdict of string * jtype (* kind of keys *)
+ | Jlist of jtype (* order does not matter *)
+ | Jarray of jtype (* order matters *)
+ | Jtuple of jtype list
+ | Junion of jtype list
+ | Jrecord of (string * jtype) list
+ | Jdata of ident
+ | Jenum of ident (* enum type declaration *)
+ | Jself (* for (simply) recursive types *)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Declarations --- *)
+(* -------------------------------------------------------------------------- *)
+
+type fieldInfo = {
+ fd_name: string;
+ fd_type: jtype;
+ fd_descr: Markdown.text;
+}
+
+type tagInfo = {
+ tg_name: string;
+ tg_label: Markdown.text;
+ tg_descr: Markdown.text;
+}
+
+type paramInfo =
+ | P_value of jtype
+ | P_named of fieldInfo list
+
+type requestInfo = {
+ rq_kind: [ `GET | `SET | `EXEC ];
+ rq_input: paramInfo ;
+ rq_output: paramInfo ;
+}
+
+type arrayInfo = {
+ arr_key: string;
+ arr_kind: string;
+}
+
+type declKindInfo =
+ | D_signal
+ | D_type of jtype
+ | D_enum of tagInfo list
+ | D_record of fieldInfo list
+ | D_request of requestInfo
+ | D_value of jtype
+ | D_state of jtype
+ | D_array of arrayInfo (* key kind *)
+ | D_safe of ident * jtype (* safe decoder *)
+ | D_loose of ident * jtype (* loose decoder *)
+ | D_order of ident * jtype (* natural ordering *)
+
+type declInfo = {
+ d_ident : ident;
+ d_descr : Markdown.text;
+ d_kind : declKindInfo;
+}
+
+type packageInfo = {
+ p_plugin : plugin ;
+ p_package : string list ;
+ p_title : string ;
+ p_descr : Markdown.text ;
+ p_readme : string option ;
+ p_content : declInfo list ;
+}
+
+let name_of_ident ?(sep=".") id =
+ String.concat sep @@ match id.plugin with
+ | Kernel -> "kernel" :: id.package @ [ id.name ]
+ | Plugin p -> "plugins" :: p :: (id.package @ [id.name ])
+
+let name_of_pkg ?(sep=".") plugin package =
+ String.concat sep @@ match plugin with
+ | Kernel -> "kernel" :: package
+ | Plugin p -> "plugins" :: p :: package
+
+let name_of_pkginfo ?sep { p_plugin ; p_package } =
+ name_of_pkg ?sep p_plugin p_package
+
+let pp_pkgname fmt { p_plugin ; p_package } =
+ ( pp_plugin fmt p_plugin ;
+ List.iter (pp_step fmt) p_package )
+
+(* -------------------------------------------------------------------------- *)
+(* --- Derived Names --- *)
+(* -------------------------------------------------------------------------- *)
+
+let derived ?prefix ?suffix id =
+ let capitalize = String.capitalize_ascii in
+ match prefix , suffix with
+ | None , None -> id
+ | Some p , None -> { id with name = p ^ capitalize id.name }
+ | None , Some q -> { id with name = id.name ^ q }
+ | Some p , Some q -> { id with name = p ^ capitalize id.name ^ q }
+
+module Derived =
+struct
+ let signal id = derived ~prefix:"signal" id
+ let getter id = derived ~prefix:"get" id
+ let setter id = derived ~prefix:"set" id
+ let data id = derived ~suffix:"Data" id
+ let fetch id = derived ~prefix:"fetch" id
+ let reload id = derived ~prefix:"reload" id
+ let order id = derived ~prefix:"by" id
+ let loose id = derived ~prefix:"j" id
+ let safe id = derived ~prefix:"j" ~suffix:"Safe" id
+ let decode ~safe:ok id = if ok then safe id else loose id
+end
+
+(* -------------------------------------------------------------------------- *)
+(* --- Visitors --- *)
+(* -------------------------------------------------------------------------- *)
+
+let rec isRecursive = function
+ | Jself -> true
+ | Jdata _ | Jenum _
+ | Jany | Jnull | Jboolean | Jnumber
+ | Jstring | Jalpha | Jkey _ | Jindex _ -> false
+ | Joption js | Jdict(_,js) | Jarray js | Jlist js -> isRecursive js
+ | Jtuple js | Junion js -> List.exists isRecursive js
+ | Jrecord fjs -> List.exists (fun (_,js) -> isRecursive js) fjs
+
+let rec visit_jtype fn = function
+ | Jany | Jself | Jnull | Jboolean | Jnumber
+ | Jstring | Jalpha | Jkey _ | Jindex _ -> ()
+ | Joption js | Jdict(_,js) | Jarray js | Jlist js -> visit_jtype fn js
+ | Jtuple js | Junion js -> List.iter (visit_jtype fn) js
+ | Jrecord fjs -> List.iter (fun (_,js) -> visit_jtype fn js) fjs
+ | Jdata id | Jenum id ->
+ begin
+ fn id ;
+ fn (Derived.safe id) ;
+ fn (Derived.loose id) ;
+ fn (Derived.order id) ;
+ end
+
+let visit_field f { fd_type } = visit_jtype f fd_type
+
+let visit_param f = function
+ | P_value js -> visit_jtype f js
+ | P_named fds -> List.iter (visit_field f) fds
+
+let visit_request f { rq_input ; rq_output } =
+ ( visit_param f rq_input ; visit_param f rq_output )
+
+let visit_dkind f = function
+ | D_signal | D_enum _ | D_array _ -> ()
+ | D_type js | D_state js | D_value js -> visit_jtype f js
+ | D_loose(id,js) | D_safe(id,js) | D_order(id,js) -> f id ; visit_jtype f js
+ | D_record fds -> List.iter (visit_field f) fds
+ | D_request rq -> visit_request f rq
+
+let visit_decl f { d_kind } = visit_dkind f d_kind
+
+let visit_package_decl f { p_content } =
+ List.iter (fun { d_ident } -> f d_ident) p_content
+
+let visit_package_used f { p_content } =
+ List.iter (visit_decl f) p_content
+
+let resolve ?(keywords=[]) pkg =
+ let scope = Scope.create pkg.p_plugin in
+ List.iter (Scope.reserve scope) keywords ;
+ visit_package_decl (Scope.declare scope) pkg ;
+ visit_package_used (Scope.use scope) pkg ;
+ Scope.resolve scope
+
+(* -------------------------------------------------------------------------- *)
+(* --- Server API --- *)
+(* -------------------------------------------------------------------------- *)
+
+type package = {
+ pkgInfo : packageInfo ; (* with empty decl *)
+ mutable revDecl : declInfo list ; (* in reverse order *)
+}
+
+let field fd = fd.fd_name , fd.fd_type
+
+let name_of_package ?sep pkg = name_of_pkginfo ?sep pkg.pkgInfo
+
+let registry = ref IdSet.empty (* including packages *)
+let packages = ref [] (* in reverse order *)
+let collection = ref None (* computed *)
+
+let name_re = Str.regexp "^[a-zA-Z0-9]+$"
+let package_re = Str.regexp "^[a-z0-9]+\\(\\.[a-z0-9]+\\)*$"
+
+let check_package pkg =
+ if not (Str.string_match package_re pkg 0) then
+ Senv.fatal
+ "Invalid package identifier %S (use dot separated lowercase names)"
+ pkg
+
+let check_name name =
+ if not (Str.string_match name_re name 0) then
+ Senv.fatal
+ "Invalid identifier %S (use « camlCased » names)" name
+
+let register_ident id =
+ if IdSet.mem id !registry then
+ Senv.fatal "Duplicate identifier '%a'" pp_ident id ;
+ registry := IdSet.add id !registry
+
+let resolve_readme ~plugin = function
+ | None -> None
+ | Some readme ->
+ let file =
+ match plugin with
+ | Kernel ->
+ Printf.sprintf "%s/server/%s" Fc_config.datadir readme
+ | Plugin name ->
+ Printf.sprintf "%s/%s/server/%s" Fc_config.datadir name readme
+ in Some file
+
+(* -------------------------------------------------------------------------- *)
+(* --- Declarations --- *)
+(* -------------------------------------------------------------------------- *)
+
+let package ?plugin ?name ~title ?(descr=[]) ?readme () =
+ let plugin = match plugin with None -> Kernel | Some p -> Plugin p in
+ let pkgname = match name with
+ | None -> []
+ | Some pkg -> check_package pkg ; String.split_on_char '.' pkg in
+ let pkgid = { plugin ; package = pkgname ; name = "*"} in
+ let pkgInfo = {
+ p_plugin = plugin ;
+ p_package = pkgname ;
+ p_title = title ;
+ p_descr = descr ;
+ p_readme = resolve_readme ~plugin readme ;
+ p_content = [] ;
+ } in
+ let package = { pkgInfo ; revDecl=[] } in
+ register_ident pkgid ;
+ collection := None ;
+ packages := package :: !packages ;
+ package
+
+let declare_id ~package:pkg ~name ?(descr=[]) decl =
+ check_name name ;
+ let { p_plugin = plugin ; p_package = package } = pkg.pkgInfo in
+ let ident = { plugin ; package ; name } in
+ let decl = { d_ident=ident ; d_descr=descr ; d_kind=decl } in
+ register_ident ident ;
+ pkg.revDecl <- decl :: pkg.revDecl ; ident
+
+let declare ~package ~name ?descr decl =
+ let _id = declare_id ~package ~name ?descr decl in ()
+
+let update ~package:pkg ~name decl =
+ pkg.revDecl <- List.map
+ (fun curr ->
+ if curr.d_ident.name = name then
+ { curr with d_kind = decl }
+ else curr
+ ) pkg.revDecl
+
+let iter f =
+ List.iter f @@
+ match !collection with
+ | Some pkgs -> pkgs
+ | None ->
+ let pkgs =
+ List.sort (fun a b -> Std.compare a.p_plugin b.p_plugin) @@
+ List.rev_map
+ (fun pkg -> { pkg.pkgInfo with p_content = List.rev pkg.revDecl })
+ !packages
+ in collection := Some pkgs ; pkgs
+
+(* -------------------------------------------------------------------------- *)
+(* --- JSON To MarkDown --- *)
+(* -------------------------------------------------------------------------- *)
+
+let key kd = Md.plain (Printf.sprintf "`#%s`" kd)
+let index kd = Md.plain (Printf.sprintf "`#0%s`" kd)
+let escaped tag = Md.plain (Printf.sprintf "`\"%s\"`" @@ String.escaped tag)
+
+type pp = {
+ self: Md.text ;
+ ident: ident -> Md.text ;
+}
+
+let rec md_jtype pp = function
+ | Jany -> Md.emph "any"
+ | Jself -> pp.self
+ | Jnull -> Md.emph "null"
+ | Jnumber -> Md.emph "number"
+ | Jboolean -> Md.emph "boolean"
+ | Jstring | Jalpha -> Md.emph "string"
+ | Jkey kd -> key kd
+ | Jindex kd -> index kd
+ | Jdata id | Jenum id -> pp.ident id
+ | Joption js -> protect pp js @ Md.code "?"
+ | Jtuple js -> Md.code "[" @ md_jlist pp "," js @ Md.code "]"
+ | Junion js -> md_jlist pp "|" js
+ | Jarray js | Jlist js -> protect pp js @ Md.code "[]"
+ | Jrecord fjs -> Md.code "{" @ fields pp fjs @ Md.code "}"
+ | Jdict (id,js) ->
+ Md.code "{[" @ key id @ Md.code "]:" @ md_jtype pp js @ Md.code "}"
+
+and md_jlist pp sep js =
+ Md.glue ~sep:(Md.plain sep) (List.map (md_jtype pp) js)
+
+and fields pp fjs =
+ Md.glue ~sep:(Md.plain ",") @@
+ List.map (fun (fd,js) ->
+ escaped fd @
+ match js with
+ | Joption js -> Md.code ":?" @ md_jtype pp js
+ | _ -> Md.code ":" @ md_jtype pp js
+ ) fjs
+
+and protect names js =
+ match js with
+ | Junion _ -> Md.code "(" @ md_jtype names js @ Md.code ")"
+ | _ -> md_jtype names js
+
+(* -------------------------------------------------------------------------- *)
+(* --- Tags & Fields --- *)
+(* -------------------------------------------------------------------------- *)
+
+let md_tags ?(title="Tags") (tags : tagInfo list) =
+ let header = Md.[
+ plain title, Left;
+ plain "Value", Left;
+ plain "Description", Left
+ ] in
+ let row tg = [
+ tg.tg_label ;
+ escaped tg.tg_name ;
+ tg.tg_descr ;
+ ] in
+ Md.{ caption = None ; header ; content = List.map row tags }
+
+let md_fields ?(title="Field") pp (fields : fieldInfo list) =
+ let header = Md.[
+ plain title, Left;
+ plain "Format", Center;
+ plain "Description", Left;
+ ] in
+ let row f =
+ match f.fd_type with
+ | Joption js -> [
+ escaped (f.fd_name ^ "?") ;
+ md_jtype pp js ;
+ f.fd_descr ;
+ ]
+ | _ -> [
+ escaped f.fd_name ;
+ md_jtype pp f.fd_type ;
+ f.fd_descr ;
+ ]
+ in
+ Md.{ caption = None ; header ; content = List.map row fields }
+
+(* -------------------------------------------------------------------------- *)
+(* --- Printer --- *)
+(* -------------------------------------------------------------------------- *)
+
+let pp_jtype fmt js =
+ let scope = Scope.create Kernel in
+ visit_jtype (Scope.use scope) js ;
+ let ns = Scope.resolve scope in
+ let self = Md.emph "self" in
+ let ident id = Md.emph (IdMap.find id ns) in
+ Markdown.pp_text fmt (md_jtype { self ; ident } js)
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/package.mli b/src/plugins/server/package.mli
new file mode 100644
index 0000000000000000000000000000000000000000..c040c985bc85129a3c15bb222e1afdffaf2262a4
--- /dev/null
+++ b/src/plugins/server/package.mli
@@ -0,0 +1,231 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Constituant of the Server API --- *)
+(* -------------------------------------------------------------------------- *)
+
+type plugin = Kernel | Plugin of string
+type ident = private { plugin: plugin; package: string list; name: string; }
+
+type jtype =
+ | Jany
+ | Jnull
+ | Jboolean
+ | Jnumber
+ | Jstring
+ | Jalpha (** string primarily compared without case *)
+ | Jkey of string (** kind of a string used for indexing *)
+ | Jindex of string (** kind of an integer used for indexing *)
+ | Joption of jtype
+ | Jdict of string * jtype (** kind of keys *)
+ | Jlist of jtype (** order does not matter *)
+ | Jarray of jtype (** order matters *)
+ | Jtuple of jtype list
+ | Junion of jtype list
+ | Jrecord of (string * jtype) list
+ | Jdata of ident
+ | Jenum of ident (** data that is an enum *)
+ | Jself (** for (simply) recursive types *)
+
+type fieldInfo = {
+ fd_name: string;
+ fd_type: jtype;
+ fd_descr: Markdown.text;
+}
+
+type tagInfo = {
+ tg_name: string;
+ tg_label: Markdown.text;
+ tg_descr: Markdown.text;
+}
+
+type paramInfo =
+ | P_value of jtype
+ | P_named of fieldInfo list
+
+type requestInfo = {
+ rq_kind: [ `GET | `SET | `EXEC ];
+ rq_input: paramInfo ;
+ rq_output: paramInfo ;
+}
+
+type arrayInfo = {
+ arr_key: string;
+ arr_kind: string;
+}
+
+type declKindInfo =
+ | D_signal
+ | D_type of jtype
+ | D_enum of tagInfo list
+ | D_record of fieldInfo list
+ | D_request of requestInfo
+ | D_value of jtype
+ | D_state of jtype
+ | D_array of arrayInfo
+ | D_safe of ident * jtype (* safe decoder *)
+ | D_loose of ident * jtype (* loose decoder *)
+ | D_order of ident * jtype (* natural ordering *)
+
+type declInfo = {
+ d_ident : ident;
+ d_descr : Markdown.text;
+ d_kind : declKindInfo;
+}
+
+type packageInfo = {
+ p_plugin : plugin ;
+ p_package : string list ;
+ p_title : string ;
+ p_descr : Markdown.text ;
+ p_readme : string option ;
+ p_content : declInfo list ;
+}
+
+(* -------------------------------------------------------------------------- *)
+(* --- Pretty Printers --- *)
+(* -------------------------------------------------------------------------- *)
+
+val pp_plugin : Format.formatter -> plugin -> unit
+val pp_pkgname : Format.formatter -> packageInfo -> unit
+val pp_ident : Format.formatter -> ident -> unit
+val pp_jtype : Format.formatter -> jtype -> unit
+
+(* -------------------------------------------------------------------------- *)
+(* --- Derived Names --- *)
+(* -------------------------------------------------------------------------- *)
+
+val derived : ?prefix:string -> ?suffix:string -> ident -> ident
+
+module Derived :
+sig
+ val signal : ident -> ident
+ val getter : ident -> ident
+ val setter : ident -> ident
+ val data : ident -> ident
+ val fetch : ident -> ident
+ val reload : ident -> ident
+ val safe : ident -> ident
+ val loose : ident -> ident
+ val order : ident -> ident
+ val decode : safe:bool -> ident -> ident
+end
+
+(* -------------------------------------------------------------------------- *)
+(* --- Names Resolution --- *)
+(* -------------------------------------------------------------------------- *)
+
+module IdMap : Map.S with type key = ident
+
+module Scope :
+sig
+ type t
+ val create : plugin -> t
+ val reserve : t -> string -> unit (** Must _not_ be call after [use] *)
+ val declare : t -> ident -> unit (** Must _not_ be call after [use] *)
+ val use : t -> ident -> unit
+ val resolve : t -> string IdMap.t
+end
+
+val isRecursive : jtype -> bool
+val visit_jtype : (ident -> unit) -> jtype -> unit
+val visit_field: (ident -> unit) -> fieldInfo -> unit
+val visit_param: (ident -> unit) -> paramInfo -> unit
+val visit_request: (ident -> unit) -> requestInfo -> unit
+val visit_dkind: (ident -> unit) -> declKindInfo -> unit
+val visit_decl: (ident -> unit) -> declInfo -> unit
+val visit_package_decl: (ident -> unit) -> packageInfo -> unit
+val visit_package_used: (ident -> unit) -> packageInfo -> unit
+
+(* -------------------------------------------------------------------------- *)
+(* --- Server API --- *)
+(* -------------------------------------------------------------------------- *)
+
+type package
+
+val package :
+ ?plugin:string ->
+ ?name:string ->
+ title:string ->
+ ?descr:Markdown.text ->
+ ?readme:string ->
+ unit -> package
+
+(**
+ Register the declaration in the Server API.
+ This is only way to obtain identifiers.
+ This ensures identifiers are declared before being used.
+*)
+val declare :
+ package:package ->
+ name:string ->
+ ?descr:Markdown.text ->
+ declKindInfo ->
+ unit
+
+(**
+ Same as [declare] but returns the associated identifier.
+*)
+val declare_id :
+ package:package ->
+ name:string ->
+ ?descr:Markdown.text ->
+ declKindInfo ->
+ ident
+
+(**
+ Replace the declaration for the given name in the package.
+*)
+val update :
+ package:package ->
+ name:string ->
+ declKindInfo ->
+ unit
+
+val iter : (packageInfo -> unit) -> unit
+
+(** Assigns non-classing names for each identifier. *)
+val resolve : ?keywords: string list -> packageInfo -> string IdMap.t
+
+val field : fieldInfo -> string * jtype
+val name_of_pkg : ?sep:string -> plugin -> string list -> string
+val name_of_pkginfo : ?sep:string -> packageInfo -> string
+val name_of_package : ?sep:string -> package -> string
+val name_of_ident : ?sep:string -> ident -> string
+
+(* -------------------------------------------------------------------------- *)
+(* --- Markdown Generation --- *)
+(* -------------------------------------------------------------------------- *)
+
+type pp = {
+ self: Markdown.text ;
+ ident: ident -> Markdown.text ;
+}
+
+val escaped : string -> Markdown.text
+
+val md_jtype : pp -> jtype -> Markdown.text
+val md_tags : ?title:string -> tagInfo list -> Markdown.table
+val md_fields : ?title:string -> pp -> fieldInfo list -> Markdown.table
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/request.ml b/src/plugins/server/request.ml
index cb0de2eb1945f2321397535d0c48b6e741d5545c..24a94eb02af6333e5462cff3f29ef2ba0fdf11d1 100644
--- a/src/plugins/server/request.ml
+++ b/src/plugins/server/request.ml
@@ -20,6 +20,8 @@
(* *)
(**************************************************************************)
+open Package
+
module Senv = Server_parameters
module Jutil = Yojson.Basic.Util
@@ -33,75 +35,29 @@ type kind = [ `GET | `SET | `EXEC ]
module type Input =
sig
type t
- val syntax : Syntax.t
+ val jtype : jtype
val of_json : json -> t
end
module type Output =
sig
type t
- val syntax : Syntax.t
+ val jtype : jtype
val to_json : t -> json
end
type 'a input = (module Input with type t = 'a)
type 'a output = (module Output with type t = 'a)
-(* -------------------------------------------------------------------------- *)
-(* --- Sanity Checks --- *)
-(* -------------------------------------------------------------------------- *)
-
-let re_name = Str.regexp_case_fold "[a-zA-Z0-9._]+$"
-
-let wpage = Senv.register_warn_category "inconsistent-page"
-let wkind = Senv.register_warn_category "inconsistent-kind"
-
-let check_name name =
- if not (Str.string_match re_name name 0) then
- Senv.warning ~wkey:Senv.wname
- "Request %S is not a dot-separated list of (camlCased) identifiers" name
-
-let check_plugin plugin name =
- let p = String.lowercase_ascii plugin in
- let n = String.lowercase_ascii name in
- let k = String.length plugin in
- if not (String.length name > k &&
- String.sub n 0 k = p &&
- String.get n k = '.')
- then
- Senv.warning ~wkey:wpage
- "Request '%s' shall be named « %s.* »"
- name (String.capitalize_ascii plugin)
-
-let check_page page name =
- match Doc.chapter page with
- | `Kernel -> check_plugin "kernel" name
- | `Plugin plugin -> check_plugin plugin name
- | `Protocol ->
- Senv.warning ~wkey:wkind
- "Request '%s' shall not be published in protocol pages" name
-
-let page_prefix page =
- match Doc.chapter page with
- | `Kernel -> "kernel"
- | `Plugin plugin -> plugin
- | `Protocol -> "protocol"
-
(* -------------------------------------------------------------------------- *)
(* --- Signals --- *)
(* -------------------------------------------------------------------------- *)
type signal = Main.signal
-let signal ~page ~name ~descr ?(details=[]) () =
- let open Markdown in
- check_name name ;
- check_page page name ;
- let title = Printf.sprintf "`SIG` %s" name in
- let index = [ Printf.sprintf "%s (`SIGNAL`)" name ] in
- let contents = [ Block [Text descr] ; Block details] in
- let _ = Doc.publish ~page ~name ~title ~index ~contents () in
- Main.signal name
+let signal ~package ~name ~descr =
+ let id = Package.declare_id ~package ~name ~descr D_signal in
+ Main.signal (Package.name_of_ident id)
let emit = Main.emit
let on_signal = Main.on_signal
@@ -135,51 +91,32 @@ type 'a result = rq -> 'a -> unit
type _ rq_input =
| Pnone
| Pdata : 'a input -> 'a rq_input
- | Pfields : Syntax.field list -> unit rq_input
+ | Pfields : fieldInfo list -> unit rq_input
type _ rq_output =
| Rnone
| Rdata : 'a output -> 'a rq_output
- | Rfields : Syntax.field list -> unit rq_output
+ | Rfields : fieldInfo list -> unit rq_output
(* json input syntax *)
-let sy_input (type a) (input : a rq_input) : Syntax.t =
- match input with
- | Pnone -> assert false
- | Pdata d -> let module D = (val d) in D.syntax
- | Pfields _ -> Syntax.record []
-
-(* json output syntax *)
-let sy_output (type b) (output : b rq_output) : Syntax.t =
- match output with
- | Rnone -> assert false
- | Rdata d -> let module D = (val d) in D.syntax
- | Rfields _ -> Syntax.record []
-
-(* json input documentation *)
-let doc_input (type a) (input : a rq_input) =
+let rq_input (type a) (input : a rq_input) : paramInfo =
match input with
| Pnone -> assert false
- | Pdata _ -> []
- | Pfields fs -> [Syntax.fields ~title:"Input Params" (List.rev fs)]
+ | Pdata d -> let module D = (val d) in P_value D.jtype
+ | Pfields fds -> P_named fds
(* json output syntax *)
-let doc_output (type b) (output : b rq_output) =
+let rq_output (type b) (output : b rq_output) : paramInfo =
match output with
| Rnone -> assert false
- | Rdata _ -> []
- | Rfields fs -> [Syntax.fields ~title:"Output Params" (List.rev fs)]
+ | Rdata d -> let module D = (val d) in P_value D.jtype
+ | Rfields fds -> P_named fds
(* -------------------------------------------------------------------------- *)
(* --- Multi-Parameters Requests --- *)
(* -------------------------------------------------------------------------- *)
type ('a,'b) signature = {
- page : Doc.page ;
- kind : kind ;
- name : string ;
- descr : Markdown.text ;
- details : Markdown.block ;
mutable defined : bool ;
mutable defaults : json Fmap.t ;
mutable required : string list ;
@@ -198,21 +135,22 @@ let check_required fmap fd =
(* -------------------------------------------------------------------------- *)
(* current input fields *)
-let fds_input s : Syntax.field list =
- if s.defined then Senv.failure "Request '%s' has been finalized." s.name ;
+let fds_input s : fieldInfo list =
+ if s.defined then
+ raise (Invalid_argument "Server.Request: already published");
match s.input with
| Pdata _ ->
- Senv.fatal "Can not define named parameters for request '%s'" s.name
+ raise (Invalid_argument "Server.Request: request has not named input");
| Pnone -> []
| Pfields fds -> fds
let param (type a b) (s : (unit,b) signature) ~name ~descr
?default (input : a input) : a param =
let module D = (val input) in
- let syntax = if default = None then D.syntax else Syntax.option D.syntax in
- let fd = Syntax.{
+ let ftype = if default = None then D.jtype else Joption D.jtype in
+ let fd = Package.{
fd_name = name ;
- fd_syntax = syntax ;
+ fd_type = ftype ;
fd_descr = descr ;
} in
s.input <- Pfields (fd :: fds_input s) ;
@@ -226,9 +164,9 @@ let param (type a b) (s : (unit,b) signature) ~name ~descr
let param_opt (type a b) (s : (unit,b) signature) ~name ~descr
(input : a input) : a option param =
let module D = (val input) in
- let fd = Syntax.{
+ let fd = Package.{
fd_name = name ;
- fd_syntax = Syntax.option D.syntax ;
+ fd_type = Joption D.jtype ;
fd_descr = descr ;
} in
s.input <- Pfields (fd :: fds_input s) ;
@@ -241,19 +179,21 @@ let param_opt (type a b) (s : (unit,b) signature) ~name ~descr
(* -------------------------------------------------------------------------- *)
(* current output fields *)
-let fds_output s : Syntax.field list =
- if s.defined then Senv.failure "Request '%s' has been finalized." s.name ;
+let fds_output s : fieldInfo list =
+ if s.defined then
+ raise (Invalid_argument "Server.Request: already published");
match s.output with
- | Rdata _ -> Senv.fatal "Can not define named results request '%s'" s.name
+ | Rdata _ ->
+ raise (Invalid_argument "Server.Request: request has not named input");
| Rnone -> []
| Rfields fds -> fds
let result (type a b) (s : (a,unit) signature) ~name ~descr
?default (output : b output) : b result =
let module D = (val output) in
- let fd = Syntax.{
+ let fd = Package.{
fd_name = name ;
- fd_syntax = D.syntax ;
+ fd_type = D.jtype ;
fd_descr = descr ;
} in
s.output <- Rfields (fd :: fds_output s) ;
@@ -267,9 +207,9 @@ let result (type a b) (s : (a,unit) signature) ~name ~descr
let result_opt (type a b) (s : (a,unit) signature) ~name ~descr
(output : b output) : b option result =
let module D = (val output) in
- let fd = Syntax.{
+ let fd = Package.{
fd_name = name ;
- fd_syntax = option D.syntax ;
+ fd_type = Joption D.jtype ;
fd_descr = descr ;
} in
s.output <- Rfields (fd :: fds_output s) ;
@@ -281,14 +221,10 @@ let result_opt (type a b) (s : (a,unit) signature) ~name ~descr
(* --- Opened Signature Definition --- *)
(* -------------------------------------------------------------------------- *)
-let signature
- ~page ~kind ~name ~descr ?(details=[]) ?input ?output () =
- check_name name ;
- check_page page name ;
+let signature ?input ?output () =
let input = match input with None -> Pnone | Some d -> Pdata d in
let output = match output with None -> Rnone | Some d -> Rdata d in
{
- page ; kind ; name ; descr ; details ;
defaults = Fmap.empty ; required = [] ;
input ; output ; defined = false ;
}
@@ -325,49 +261,45 @@ let mk_output (type b) name required (output : b rq_output) : (rq -> b -> json)
List.iter (check_required rq.result) required ;
fmap_to_json rq.result)
-let register_sig (type a b) (s : (a,b) signature) (process : rq -> a -> b) =
- let open Markdown in
+let register_sig (type a b)
+ ~package ~kind ~name ~descr
+ (s : (a,b) signature) (process : rq -> a -> b) =
if s.defined then
- Senv.fatal "Request '%s' is defined twice" s.name ;
- let input = mk_input s.name s.defaults s.input in
- let output = mk_output s.name s.required s.output in
+ Senv.fatal "Request '%s' is defined twice" name ;
+ let input = mk_input name s.defaults s.input in
+ let output = mk_output name s.required s.output in
let processor js =
let rq = { param = Fmap.empty ; result = Fmap.empty } in
js |> input rq |> process rq |> output rq
in
- let skind = Main.string_of_kind s.kind in
- let title = Printf.sprintf "`%s` %s" skind s.name in
- let index = [ Printf.sprintf "%s (`%s`)" s.name skind ] in
- let input =
- Syntax.define (plain "Input") (Syntax.text @@ sy_input s.input) in
- let output =
- Syntax.define (plain "Output") (Syntax.text @@ sy_output s.output) in
- let contents =
- Block ( Text s.descr :: input :: output :: s.details ) ::
- ( doc_input s.input @ doc_output s.output )
- in
- let _ = Doc.publish ~page:s.page ~name:s.name ~title ~index ~contents () in
- Main.register s.kind s.name processor ;
+ let request = D_request {
+ rq_kind = kind ;
+ rq_input = rq_input s.input ;
+ rq_output = rq_output s.output ;
+ } in
+ let id = declare_id ~package ~name ~descr request in
+ Main.register kind (name_of_ident id) processor ;
s.defined <- true
(* -------------------------------------------------------------------------- *)
(* --- Request Registration --- *)
(* -------------------------------------------------------------------------- *)
-let register ~page ~kind ~name ~descr ?details ~input ~output process =
- register_sig
- (signature ~page ~kind ~name ~descr ?details ~input ~output ())
+let register ~package ~kind ~name ~descr ~input ~output process =
+ register_sig ~package ~kind ~name ~descr
+ (signature ~input ~output ())
(fun _rq v -> process v)
-let dictionary (d : 'a Data.Enum.dictionary) =
- let name = Data.Enum.name d in
- let page = Data.Enum.page d in
- let descr = Markdown.plain "Returns all tags registered for" @
- Data.Enum.syntax d in
- register ~kind:`GET ~page
- ~name:(Printf.sprintf "%s.dictionary.%s" (page_prefix page) name) ~descr
- ~input:(module Data.Junit)
- ~output:(module Data.Tag.Jlist)
- (fun () -> Data.Enum.tags d)
+let dictionary (type a) ~package ~name ~descr (d : a Data.Enum.dictionary) =
+ let open Data in
+ let data = Enum.publish ~package ~name ~descr d in
+ let descr = Markdown.plain "Registered tags for the above type." in
+ let name = name ^ "Tags" in
+ register ~kind:`GET ~package
+ ~name ~descr
+ ~input:(module Junit)
+ ~output:(module Jlist(Tag))
+ (fun () -> Enum.tags d) ;
+ data
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/request.mli b/src/plugins/server/request.mli
index d3c120adf9e0fc348095180d1ae9b5bd00ae3743..2ad33bcacf350678facf25ed8029f866f81ab9c8 100644
--- a/src/plugins/server/request.mli
+++ b/src/plugins/server/request.mli
@@ -24,20 +24,22 @@
(** Request Registry *)
(* -------------------------------------------------------------------------- *)
+open Package
+
type json = Data.json
type kind = [ `GET | `SET | `EXEC ]
module type Input =
sig
type t
- val syntax : Syntax.t
+ val jtype : jtype
val of_json : json -> t
end
module type Output =
sig
type t
- val syntax : Syntax.t
+ val jtype : jtype
val to_json : t -> json
end
@@ -60,11 +62,10 @@ type signal
(** Register a server signal. The signal [name] must be unique. *)
val signal :
- page:Doc.page ->
+ package:package ->
name:string ->
descr:Markdown.text ->
- ?details:Markdown.block ->
- unit -> signal
+ signal
(** Emit the signal to the client. *)
val emit : signal -> unit
@@ -87,11 +88,10 @@ val on_signal : signal -> (bool -> unit) -> unit
*)
val register :
- page:Doc.page ->
+ package:package ->
kind:kind ->
name:string ->
descr:Markdown.text ->
- ?details:Markdown.block ->
input:'a input ->
output:'b output ->
('a -> 'b) -> unit
@@ -133,11 +133,6 @@ type ('a,'b) signature
you shall define named parameters and results before registering the
request processing function. *)
val signature :
- page:Doc.page ->
- kind:kind ->
- name:string ->
- descr:Markdown.text ->
- ?details:Markdown.block ->
?input:'a input ->
?output:'b output ->
unit -> ('a,'b) signature
@@ -154,7 +149,12 @@ type 'b result = rq -> 'b -> unit
(** Register the request JSON processing function.
This call finalize the signature definition and shall be called
once on the signature. *)
-val register_sig : ('a,'b) signature -> (rq -> 'a -> 'b) -> unit
+val register_sig :
+ package:package ->
+ kind:kind ->
+ name:string ->
+ descr:Markdown.text ->
+ ('a,'b) signature -> (rq -> 'a -> 'b) -> unit
(** {2 Named Parameters and Results}
@@ -224,6 +224,10 @@ val result_opt : ('a,unit) signature ->
(** Register a [GET] request [dictionary.<name>] to retrieve all tags registered
in the dictionary. *)
-val dictionary : 'a Data.Enum.dictionary -> unit
+val dictionary :
+ package:package ->
+ name:string ->
+ descr:Markdown.text ->
+ 'a Data.Enum.dictionary -> (module Data.S with type t = 'a)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/server_batch.ml b/src/plugins/server/server_batch.ml
index 7a3d49363143ce3649dd4d0cb29133444dc6e61e..2df2d4d2567d1649b23219aa05712a9886951398 100644
--- a/src/plugins/server/server_batch.ml
+++ b/src/plugins/server/server_batch.ml
@@ -52,7 +52,7 @@ module BatchOutputDir = Senv.Empty_string
directory."
end)
-let _ = Doc.page `Protocol ~title:"Batch Protocol" ~filename:"server_batch.md"
+let () = Server_doc.protocole ~title:"Batch Protocol" ~readme:"server_batch.md"
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/doc.ml b/src/plugins/server/server_doc.ml
similarity index 58%
rename from src/plugins/server/doc.ml
rename to src/plugins/server/server_doc.ml
index 5da581570cc7a043548647c9c2d956e8a3674ab1..522cc6584cfffdbadf3508ce01515780ef9ab1d5 100644
--- a/src/plugins/server/doc.ml
+++ b/src/plugins/server/server_doc.ml
@@ -24,8 +24,9 @@
(* --- Server Documentation --- *)
(* -------------------------------------------------------------------------- *)
-open Markdown
+open Package
type json = Yojson.Basic.t
+module Md = Markdown
module Senv = Server_parameters
module Pages = Map.Make(String)
@@ -43,7 +44,8 @@ type page = {
chapter : chapter ;
title : string ;
order : int ;
- intro : Markdown.elements ;
+ descr : Markdown.elements ;
+ readme: string option ;
mutable sections : section list ;
}
@@ -60,32 +62,24 @@ let href page name : Markdown.href = Section( page.path , name )
let chapter pg = pg.chapter
-let page chapter ~title ~filename =
- let rootdir,path = match chapter with
- | `Protocol -> "." , filename
- | `Kernel -> ".." , Printf.sprintf "kernel/%s" filename
- | `Plugin name -> "../.." , Printf.sprintf "plugins/%s/%s" name filename
- in
+let path_for chapter filename =
+ match chapter with
+ | `Protocol -> "." , filename
+ | `Kernel -> ".." , Printf.sprintf "kernel/%s" filename
+ | `Plugin name -> "../.." , Printf.sprintf "plugins/%s/%s" name filename
+
+let page chapter ~title ?(descr=[]) ?readme ~filename () =
+ let rootdir , path = path_for chapter filename in
try
let other = Pages.find path !pages in
Senv.failure "Duplicate page '%s' path@." path ; other
with Not_found ->
- let intro = match chapter with
- | `Protocol ->
- Printf.sprintf "%s/server/protocol/%s" Fc_config.datadir filename
- | `Kernel ->
- Printf.sprintf "%s/server/kernel/%s" Fc_config.datadir filename
- | `Plugin name ->
- if not (List.mem name !plugins) then plugins := name :: !plugins ;
- Printf.sprintf "%s/%s/server/%s" Fc_config.datadir name filename in
- let intro =
- if Sys.file_exists intro
- then Markdown.rawfile intro
- else Markdown.(section ~title []) in
let order = incr order ; !order in
- let page = { order ; rootdir ; path ;
- chapter ; title ; intro ;
- sections=[] } in
+ let page = {
+ order ; rootdir ; path ;
+ chapter ; title ; descr ; readme ;
+ sections=[] ;
+ } in
pages := Pages.add path page !pages ; page
let static () = []
@@ -95,20 +89,128 @@ let publish ~page ?name ?(index=[]) ~title
?(generated=static)
() =
let id = match name with Some id -> id | None -> title in
- let href = Section( page.path , id ) in
+ let href = Md.Section( page.path , id ) in
let section () = Markdown.section ?name ~title (contents @ generated ()) in
List.iter (fun entry -> entries := (entry , href) :: !entries) index ;
page.sections <- section :: page.sections ; href
-let _ = page `Protocol ~title:"Architecture" ~filename:"server.md"
+let protocole ~title ~readme:filename =
+ let readme = Printf.sprintf "%s/server/%s" Fc_config.datadir filename in
+ ignore (page `Protocol ~title ~readme ~filename ())
+
+let () = protocole ~title:"Architecture" ~readme:"server.md"
+
+(* -------------------------------------------------------------------------- *)
+(* --- Package Publication --- *)
+(* -------------------------------------------------------------------------- *)
+
+let href_of_ident names id =
+ let chapter = match id.plugin with
+ | Kernel -> `Kernel | Plugin p -> `Plugin p in
+ let filename = String.concat "_" id.package ^ ".md" in
+ let page = snd @@ path_for chapter filename in
+ let text = try IdMap.find id names with Not_found -> id.name in
+ Md.link ~text:(Md.code text) ~page ~name:id.name ()
+
+let page_of_package pkg =
+ let chapter = match pkg.p_plugin with
+ | Kernel -> `Kernel | Plugin p -> `Plugin p in
+ let filename = String.concat "_" pkg.p_package ^ ".md" in
+ try
+ let _,path = path_for chapter filename in
+ Pages.find path !pages
+ with Not_found ->
+ page chapter
+ ~title:pkg.p_title
+ ~descr:(Markdown.par pkg.p_descr)
+ ?readme:pkg.p_readme
+ ~filename ()
+
+let kind_of_decl = function
+ | D_signal -> "SIGNAL"
+ | D_value _ | D_state _ -> "STATE"
+ | D_array _ -> "ARRAY"
+ | D_type _ | D_record _ | D_enum _ -> "DATA"
+ | D_request { rq_kind=`GET } -> "GET"
+ | D_request { rq_kind=`SET } -> "SET"
+ | D_request { rq_kind=`EXEC } -> "EXEC"
+ | D_loose _ | D_safe _ | D_order _ -> assert false
+
+let pp_for ?decl names =
+ let self =
+ match decl with
+ | Some d ->
+ let name = d.d_ident.name in
+ Md.link ~text:(Md.code name) ~name ()
+ | None ->
+ Md.code "self"
+ in Package.{ self ; ident = href_of_ident names }
+
+let md_param ~kind pp prm =
+ Md.emph kind @ Md.code "::=" @ match prm with
+ | P_value jt -> Package.md_jtype pp jt
+ | P_named _ -> Md.code "{" @ Md.emph (kind ^ "…") @ Md.code "}"
+
+let md_named ~kind pp = function
+ | P_value _ -> []
+ | P_named prms ->
+ let title = String.capitalize_ascii kind in
+ Md.table (Package.md_fields ~title pp prms)
+
+let descr_of_decl names decl =
+ match decl.d_kind with
+ | D_safe _ | D_loose _ | D_order _ -> assert false
+ | D_signal -> []
+ | D_state _ -> [] (* TBC *)
+ | D_value _ -> [] (* TBC *)
+ | D_array _ -> [] (* TBC *)
+ | D_type data ->
+ let pp = pp_for ~decl names in
+ Md.quote (pp.self @ Md.code "::=" @ Package.md_jtype pp data)
+ | D_record fields ->
+ let pp = pp_for ~decl names in
+ Md.quote (pp.self @ Md.code "::= {" @ Md.emph "fields…" @ Md.code "}") @
+ Md.table (Package.md_fields pp fields)
+ | D_enum tags ->
+ let pp = pp_for ~decl names in
+ Md.quote (pp.self @ Md.code "::=" @ Md.emph "tags…") @
+ Md.table (Package.md_tags tags)
+ | D_request rq ->
+ let pp = pp_for names in
+ Md.quote (md_param ~kind:"input" pp rq.rq_input) @
+ Md.quote (md_param ~kind:"output" pp rq.rq_output) @
+ md_named ~kind:"input" pp rq.rq_input @
+ md_named ~kind:"output" pp rq.rq_output
+
+let declaration page names decl =
+ match decl.d_kind with
+ | D_safe _ | D_loose _ | D_order _ -> ()
+ | _ ->
+ let name = decl.d_ident.name in
+ let fullname = name_of_ident decl.d_ident in
+ let kind = kind_of_decl decl.d_kind in
+ (* let title = Printf.sprintf "`%s` %s" kind fullname in *)
+ let title = Printf.sprintf "%s (`%s`)" fullname kind in
+ let index = [ title ] in
+ let contents = Markdown.par decl.d_descr in
+ let generated () = descr_of_decl names decl in
+ let href = publish ~page ~name ~title ~index ~contents ~generated () in
+ ignore href
+
+let package pkg =
+ begin
+ let page = page_of_package pkg in
+ let names = Package.resolve pkg in
+ List.iter (declaration page names) pkg.p_content ;
+ end
(* -------------------------------------------------------------------------- *)
(* --- Tables of Content --- *)
(* -------------------------------------------------------------------------- *)
let title_of_chapter = function
- | `Protocol -> "Server Protocols"
- | `Kernel -> "Kernel Services"
+ | `Protocol -> "Protocols"
+ | `Kernel -> "Kernel"
| `Plugin name -> "Plugin " ^ String.capitalize_ascii name
let pages_of_chapter c =
@@ -117,11 +219,12 @@ let pages_of_chapter c =
(fun _ p -> if p.chapter = c then w := p :: !w) !pages ;
List.sort (fun p q -> p.order - q.order) !w
+let table_of_page p =
+ Md.text (Md.link ~text:(Md.plain p.title) ~page:p.path ())
+
let table_of_chapter c =
- [H2 (Markdown.plain (title_of_chapter c), None);
- Block (list (List.map
- (fun p -> text (link ~text:(plain p.title) ~page:p.path ()))
- (pages_of_chapter c)))]
+ [Md.H2 (Markdown.plain (title_of_chapter c), None);
+ Md.Block (Md.list (List.map table_of_page (pages_of_chapter c)))]
let table_of_contents () =
table_of_chapter `Protocol @
@@ -138,7 +241,7 @@ module Cmap = Map.Make
end)
let index_entry (title,href) =
- text @@ Markdown.href ~text:(plain title) href
+ Md.text @@ Markdown.href ~text:(Md.plain title) href
let index () =
let category name =
@@ -159,12 +262,13 @@ let index () =
begin
List.fold_left
(fun elements (c,es) ->
- let entries = Block (list @@ List.map index_entry es) :: elements in
+ let entries =
+ Md.Block (Md.list @@ List.map index_entry es) :: elements in
if c = [] then entries
else
let cname = String.concat "." c in
let title = Printf.sprintf "Index of `%s`" cname in
- H3(plain title,None) :: entries
+ Md.H3(Md.plain title,None) :: entries
) [] categories
end
@@ -185,7 +289,7 @@ let link_page page : json list =
let maindata : json =
`Assoc [
"document", `String "Frama-C Server" ;
- "title",`String "Documentation" ;
+ "title",`String "Presentation" ;
"root", `String "." ;
]
@@ -209,7 +313,7 @@ let pp_one_page ~root ~page ~title body =
try
let chan = open_out full_path in
let fmt = Format.formatter_of_out_channel chan in
- let title = plain title in
+ let title = Md.plain title in
Markdown.(pp_pandoc ~page fmt (pandoc ~title body))
with Sys_error e ->
Senv.fatal "Could not open file %s for writing: %s" full_path e
@@ -222,9 +326,17 @@ let dump ~root ?(meta=true) () =
Pages.iter
(fun path page ->
Senv.feedback "[doc] Page: '%s'" path ;
- let body = Markdown.subsections page.intro (build [] page.sections) in
let title = page.title in
- pp_one_page ~root ~page:path ~title body ;
+ let intro = match page.readme with
+ | None -> Markdown.section ~title page.descr
+ | Some file ->
+ if Sys.file_exists file
+ then Markdown.rawfile file @ page.descr
+ else (Senv.warning "Can not find %S file" file ;
+ Markdown.section ~title page.descr)
+ in
+ let body = Markdown.subsections page.descr (build [] page.sections) in
+ pp_one_page ~root ~page:path ~title (intro @ body) ;
if meta then
let path = Printf.sprintf "%s/%s.json" root path in
Yojson.Basic.to_file path (metadata page) ;
@@ -234,16 +346,16 @@ let dump ~root ?(meta=true) () =
let path = Printf.sprintf "%s/readme.md.json" root in
Yojson.Basic.to_file path maindata ;
let body =
- [ H1 (plain "Documentation", None);
- Block (text (format "Version %s" Fc_config.version))]
+ [ Md.H1 (Md.plain "Presentation", None);
+ Md.Block (Md.text (Md.format "Version %s" Fc_config.version))]
@
table_of_contents ()
@
- [H2 (plain "Index", None)]
+ [Md.H2 (Md.plain "Index", None)]
@
index ()
in
- let title = "Documentation" in
+ let title = "Presentation" in
pp_one_page ~root ~page:"readme.md" ~title body
end
@@ -255,6 +367,7 @@ let () =
if Sys.file_exists root && Sys.is_directory root then
begin
Senv.feedback "[doc] Root: '%s'" root ;
+ Package.iter package ;
dump ~root () ;
end
else
diff --git a/src/plugins/server/doc.mli b/src/plugins/server/server_doc.mli
similarity index 88%
rename from src/plugins/server/doc.mli
rename to src/plugins/server/server_doc.mli
index 99bac4c4df90be03c3aea931c96c4a9b6c6d5a52..498ef90e74ce66ea17f54867b32dbaf04336c8c9 100644
--- a/src/plugins/server/doc.mli
+++ b/src/plugins/server/server_doc.mli
@@ -38,13 +38,17 @@ val chapter : page -> chapter
(** Obtain the given page in the server documentation.
- The page initially contains an introductory section
+ The readme introductory section is
read from the share directory:
- - [frama-c/share/protocol/<filename>] for protocol pages,
- - [frama-c/share/server/kernel/<filename>] for kernel pages,
+ - [frama-c/share/<filename>] server and kernel pages,
- [frama-c/share/<plugin>/server/<filename>] for plugin's pages.
*)
-val page : chapter -> title:string -> filename:string -> page
+val page : chapter ->
+ title:string ->
+ ?descr:elements ->
+ ?readme:string ->
+ filename:string ->
+ unit ->page
(** Adds a section in the corresponding page.
Returns an href to the published section.
@@ -60,6 +64,12 @@ val publish :
?generated:(unit -> Markdown.elements) ->
unit -> Markdown.href
+(** Publish a protocole. *)
+val protocole : title:string -> readme:string -> unit
+
+(** Publish a package. *)
+val package : Package.packageInfo -> unit
+
(** Dumps all published pages of documentations. Unless [~meta:false], also
generates METADATA for each page in [<filename>.json] for each page. *)
val dump : root:string -> ?meta:bool -> unit -> unit
diff --git a/src/plugins/server/server_zmq.ml b/src/plugins/server/server_zmq.ml
index a870c27440c867fc4722eb5a36d5fc42a5354274..a0c4928434bdc7dbfae02dba7594ee427f1b84bf 100644
--- a/src/plugins/server/server_zmq.ml
+++ b/src/plugins/server/server_zmq.ml
@@ -58,7 +58,7 @@ module Client = Senv.String
as first and unique argument."
end)
-let _ = Doc.page `Protocol ~title:"ZeroMQ Protocol" ~filename:"server_zmq.md"
+let _ = Server_doc.protocole ~title:"ZeroMQ Protocol" ~readme:"server_zmq.md"
(* -------------------------------------------------------------------------- *)
(* --- ZMQ Context --- *)
diff --git a/src/plugins/server/share/kernel/ast.md b/src/plugins/server/share/ast.md
similarity index 99%
rename from src/plugins/server/share/kernel/ast.md
rename to src/plugins/server/share/ast.md
index b5aaa2d57d7967f620d4cd9cc363691d9df7ddef..5a6af61c415c1236cd2ed78a4572ee01a16c3b46 100644
--- a/src/plugins/server/share/kernel/ast.md
+++ b/src/plugins/server/share/ast.md
@@ -12,4 +12,3 @@ Hence, most AST services might fail or return empty data if the AST has not been
actually computed before. However, in typical usage of Frama-C from the
command-line, the AST would have been computed just before any other plug-in,
including the Server.
-
diff --git a/src/plugins/server/share/kernel/kernel.md b/src/plugins/server/share/kernel.md
similarity index 100%
rename from src/plugins/server/share/kernel/kernel.md
rename to src/plugins/server/share/kernel.md
diff --git a/src/plugins/server/share/kernel/text.md b/src/plugins/server/share/kernel/text.md
deleted file mode 100644
index b73c79016e9a72b0ed8c3873527b030b23f22161..0000000000000000000000000000000000000000
--- a/src/plugins/server/share/kernel/text.md
+++ /dev/null
@@ -1,47 +0,0 @@
-# Rich Text Format
-
-In various place of the server, the Frama-C requests might return
-rich-text format, which is text annotated with special tags,
-for tagging or styling purpose.
-
-The JSON encoding of rich-text is defined by the _text_ type, which takes one
-of the following possible formats:
-
-| Format | Description |
-|:------:|:------------|
-| `"null"` | Empty text |
-| _string_ | Standard UTF-8 text |
-| `[` (_tag_`,`)? _text_`,`…`,` _text_ `]` | Sequence of text with an optional tag |
-
-Tags are simple strings, not to be printed, that encode the style or tag to
-apply on the sequence. Tags starting with a sharp (`"#…"`) must be understood as
-semantic tags, with a meaning depending on the context. Tags starting with
-a dot (`".…"`) shall be understood as style names. Other values must be understand
-as regular text.
-
-The empty tag (`""`) shall be ignored, but can used to group sequence of text
-together. Concatenation of sequence of text must be performed without any
-spacing or cut in the between.
-
-Text blocks can be nested. For instance, considerer the following JSON
-encoding:
-
-<pre>
-[
- "This ",
- [
- "#frama-c-server-doc",
- "Frama", [ ".tt", "-C" ], " server"
- ],
- " is ", [ ".it", "awesome" ], " isn't it?"
-]
-</pre>
-
-Provided the `#frama-c-server-doc` semantic is understood as a link to the
-main page of the Frama-C server documentation, the designated rich-text
-shall be printed as:
-
-> This [Frama-`C` server](../readme.md) is _awesome_ isn't it?
-
-The precise meaning of styles and semantic tags might depends on the context,
-and is detailed in each occurence of _text_ format.
diff --git a/src/plugins/server/share/kernel/project.md b/src/plugins/server/share/project.md
similarity index 100%
rename from src/plugins/server/share/kernel/project.md
rename to src/plugins/server/share/project.md
diff --git a/src/plugins/server/share/protocol/server.md b/src/plugins/server/share/server.md
similarity index 100%
rename from src/plugins/server/share/protocol/server.md
rename to src/plugins/server/share/server.md
diff --git a/src/plugins/server/share/protocol/server_batch.md b/src/plugins/server/share/server_batch.md
similarity index 100%
rename from src/plugins/server/share/protocol/server_batch.md
rename to src/plugins/server/share/server_batch.md
diff --git a/src/plugins/server/share/protocol/server_zmq.md b/src/plugins/server/share/server_zmq.md
similarity index 100%
rename from src/plugins/server/share/protocol/server_zmq.md
rename to src/plugins/server/share/server_zmq.md
diff --git a/src/plugins/server/states.ml b/src/plugins/server/states.ml
index 0a48269a12def1de8b4a5e90a66cd3762c4a8a6b..5b172c2d4efdfc5e9a25b7839fa276761fb0766b 100644
--- a/src/plugins/server/states.ml
+++ b/src/plugins/server/states.ml
@@ -43,20 +43,22 @@ let install_emit signal add_hook =
(* --- Values --- *)
(* -------------------------------------------------------------------------- *)
-let register_value (type a) ~page ~name ~descr ?(details=[])
+let register_value (type a) ~package ~name ~descr
~(output : a Request.output) ~get
?(add_hook : unit callback option) ()
=
let open Markdown in
- let title = Printf.sprintf "`VALUE` %s" name in
- let index = [ Printf.sprintf "%s (`VALUE`)" name ] in
- let contents = [ Block [Text descr] ; Block details] in
- let h = Doc.publish ~page ~name ~title ~index ~contents () in
- let signal = Request.signal ~page ~name:(name ^ ".sig")
- ~descr:(plain "Signal for value " @ href h) () in
- Request.register ~page ~kind:`GET ~name:(name ^ ".get")
- ~descr:(plain "Getter for value " @ href h)
- ~input:(module Junit) ~output get ;
+ let href = link ~name () in
+ let module D = (val output) in
+ let id = Package.declare_id
+ ~package ~name ~descr (D_value D.jtype) in
+ let signal = Request.signal
+ ~package ~name:(Package.Derived.signal id).name
+ ~descr:(plain "Signal for state" @ href) in
+ let () = Request.register
+ ~package ~name:(Package.Derived.getter id).name
+ ~descr:(plain "Getter for state" @ href)
+ ~kind:`GET ~input:(module Junit) ~output get in
install_emit signal add_hook ;
signal
@@ -64,22 +66,25 @@ let register_value (type a) ~page ~name ~descr ?(details=[])
(* --- States --- *)
(* -------------------------------------------------------------------------- *)
-let register_state (type a) ~page ~name ~descr ?(details=[])
+let register_state (type a) ~package ~name ~descr
~(data : a data) ~get ~set
?(add_hook : unit callback option) () =
let open Markdown in
- let title = Printf.sprintf "`STATE` %s" name in
- let index = [ Printf.sprintf "%s (`STATE`)" name ] in
- let contents = [ Block [Text descr] ; Block details] in
- let h = Doc.publish ~page ~name ~title ~index ~contents () in
- let signal = Request.signal ~page ~name:(name ^ ".sig")
- ~descr:(plain "Signal for state " @ href h) () in
- Request.register ~page ~kind:`GET ~name:(name ^ ".get")
- ~descr:(plain "Getter for state " @ href h)
- ~input:(module Junit) ~output:(module (val data)) get ;
- Request.register ~page ~kind:`SET ~name:(name ^ ".set")
- ~descr:(plain "Setter for state " @ href h)
- ~input:(module (val data)) ~output:(module Junit) set ;
+ let module D = (val data) in
+ let href = link ~name () in
+ let id = Package.declare_id
+ ~package ~name ~descr (D_state D.jtype) in
+ let signal = Request.signal
+ ~package ~name:(Package.Derived.signal id).name
+ ~descr:(plain "Signal for state" @ href) in
+ let () = Request.register
+ ~package ~name:(Package.Derived.getter id).name
+ ~descr:(plain "Getter for state" @ href)
+ ~kind:`GET ~input:(module Junit) ~output:(module D) get in
+ let () = Request.register
+ ~package ~name:(Package.Derived.setter id).name
+ ~descr:(plain "Setter for state" @ href)
+ ~kind:`SET ~input:(module D) ~output:(module Junit) set in
install_emit signal add_hook ;
signal
@@ -87,22 +92,20 @@ let register_state (type a) ~page ~name ~descr ?(details=[])
(* --- Model Signature --- *)
(* -------------------------------------------------------------------------- *)
-type 'a column = Syntax.field * ('a -> json)
+type 'a column = Package.fieldInfo * ('a -> json)
type 'a model = 'a column list ref
let model () = ref []
-let column (type a b) ~(model : a model) ~name ~descr
- ~(data: b Request.output) ~(get : a -> b) () =
+let column (type a b) ~name ~descr
+ ~(data: b Request.output) ~(get : a -> b) (model : a model) =
let module D = (val data) in
- if name = "key" || name = "index" then
- raise (Invalid_argument "Server.States.column: invalid name") ;
- if List.exists (fun (fd,_) -> fd.Syntax.fd_name = name) !model then
+ if List.exists (fun (fd,_) -> fd.Package.fd_name = name) !model then
raise (Invalid_argument "Server.States.column: duplicate name") ;
- let fd = Syntax.{
+ let fd = Package.{
fd_name = name ;
- fd_syntax = D.syntax ;
+ fd_type = D.jtype ;
fd_descr = descr ;
} in
model := (fd , fun a -> D.to_json (get a)) :: !model
@@ -121,6 +124,7 @@ type 'a content = {
type 'a array = {
signal : Request.signal ;
+ fkey : string ;
key : 'a -> string ;
iter : ('a -> unit) -> unit ;
getter : (string * ('a -> json)) list ;
@@ -200,21 +204,22 @@ type buffer = {
mutable updated : json list ;
}
-let add_entry buffer cols key v =
+let add_entry buffer cols fkey key v =
let fjs = List.fold_left (fun fjs (fd,to_json) ->
try (fd , to_json v) :: fjs
with Not_found -> fjs
) [] cols in
- buffer.updated <- `Assoc( ("key", `String key):: fjs) :: buffer.updated ;
+ let row = (fkey, `String key) :: fjs in
+ buffer.updated <- `Assoc row :: buffer.updated ;
buffer.capacity <- pred buffer.capacity
let remove_entry buffer key =
buffer.removed <- key :: buffer.removed ;
buffer.capacity <- pred buffer.capacity
-let update_entry buffer cols key = function
+let update_entry buffer cols fkey key = function
| Remove -> remove_entry buffer key
- | Add v -> add_entry buffer cols key v
+ | Add v -> add_entry buffer cols fkey key v
let fetch array n =
let m = content array in
@@ -234,7 +239,7 @@ let fetch array n =
begin fun v ->
let key = array.key v in
if buffer.capacity > 0 then
- add_entry buffer array.getter key v
+ add_entry buffer array.getter array.fkey key v
else
( m.updates <- Kmap.add key (Add v) m.updates ;
buffer.pending <- succ buffer.pending ) ;
@@ -244,7 +249,7 @@ let fetch array n =
m.updates <- Kmap.filter
begin fun key upd ->
if buffer.capacity > 0 then
- ( update_entry buffer array.getter key upd ; false )
+ ( update_entry buffer array.getter array.fkey key upd ; false )
else
( buffer.pending <- succ buffer.pending ; true )
end m.updates ;
@@ -255,65 +260,66 @@ let fetch array n =
(* --- Signature Registry --- *)
(* -------------------------------------------------------------------------- *)
-let register_array ~page ~name ~descr ?(details=[]) ~key
+let register_array ~package ~name ~descr ~key
+ ?(keyName="key")
+ ?(keyKind=name)
~(iter : 'a callback)
?(add_update_hook : 'a callback option)
?(add_remove_hook : 'a callback option)
?(add_reload_hook : unit callback option)
model =
let open Markdown in
- let title = Printf.sprintf "`ARRAY` %s" name in
- let index = [ Printf.sprintf "%s (`ARRAY`)" name ] in
- let columns = !model in
- let contents = [
- Block [Text descr] ;
- Syntax.fields ~title:"Columns"
- begin
- Syntax.{
- fd_name = "key" ;
- fd_syntax = Syntax.ident ;
- fd_descr = plain "entry identifier" ;
- } :: List.rev (List.map fst columns)
- end ;
- Block details
- ] in
- let mref = Doc.publish ~page:page ~name:name ~title ~index ~contents () in
- let signal = Request.signal ~page ~name:(name ^ ".sig")
- ~descr:(plain "Signal for array " @ href mref) () in
- let getter = List.map Syntax.(fun (fd,to_js) -> fd.fd_name , to_js) columns in
+ let href = link ~name () in
+ let columns = List.rev !model in
+ if List.exists (fun (fd,_) -> fd.Package.fd_name = keyName) columns then
+ raise (Invalid_argument "States.array: key name overrides column name") ;
+ let fields = Package.{
+ fd_name = keyName ;
+ fd_type = Jkey keyKind ;
+ fd_descr = plain "Entry identifier." ;
+ } :: List.map fst columns in
+ let id = Package.declare_id ~package:package ~name:name ~descr
+ (D_array { arr_key = keyName ; arr_kind = keyKind }) in
+ let signal = Request.signal
+ ~package ~name:(Package.Derived.signal id).name
+ ~descr:(plain "Signal for array" @ href) in
+ let row = Package.declare_id
+ ~package ~name:(Package.Derived.data id).name
+ ~descr:(plain "Data for array rows" @ href)
+ (D_record fields) in
+ let fs = List.map Package.field fields in
+ Data.derived ~package ~id:row (Jrecord fs) ;
+ let getter =
+ List.map Package.(fun (fd,to_js) -> fd.fd_name , to_js) !model in
let array = {
- key ; iter ; getter ; signal ;
+ fkey = keyName ; key ; iter ; getter ; signal ;
current = None ; projects = Hashtbl.create 0
} in
- let signature =
- Request.signature ~kind:`GET ~page ~name:(name ^ ".fetch")
- ~descr:(plain "Fetch updates for array " @ href mref)
- ~input:(module Jint)
- ~details:[
- Text(plain
- "Collect all entry updates since the last fetch.\n\
- The number of fetched entries is limited to the\n\
- provided integer. When `reload:true` is returned,\n\
- _all_ previously received entries must be removed.")]
- () in
- let module Jentries =
- (struct
+ let signature = Request.signature ~input:(module Jint) () in
+ let module Jkeys = Jlist(struct
+ include Jstring
+ let jtype = Package.Jkey keyKind
+ end) in
+ let module Jrows = Jlist (struct
include Jany
- let syntax = Syntax.data "entry" mref
+ let jtype = Package.Jdata row
end) in
let set_reload = Request.result signature
~name:"reload" ~descr:(plain "array fully reloaded")
(module Jbool) in
let set_removed = Request.result signature
~name:"removed" ~descr:(plain "removed entries")
- (module Jident.Jlist) in
+ (module Jkeys) in
let set_updated = Request.result signature
~name:"updated" ~descr:(plain "updated entries")
- (module Jlist(Jentries)) in
+ (module Jrows) in
let set_pending = Request.result signature
~name:"pending" ~descr:(plain "remaining entries to be fetched")
(module Jint) in
- Request.register_sig signature
+ Request.register_sig
+ ~package ~name:(Package.Derived.fetch id).name
+ ~descr:(plain "Data fetcher for array" @ href)
+ ~kind:`GET signature
begin fun rq n ->
let buffer = fetch array n in
set_reload rq buffer.reload ;
@@ -321,9 +327,10 @@ let register_array ~page ~name ~descr ?(details=[]) ~key
set_updated rq buffer.updated ;
set_pending rq buffer.pending ;
end ;
- Request.register ~kind:`GET ~page ~name:(name ^ ".reload")
- ~descr:(plain "Force full reload for array " @ href mref)
- ~input:(module Junit) ~output:(module Junit)
+ Request.register
+ ~package ~name:(Package.Derived.reload id).name
+ ~descr:(plain "Force full reload for array" @ href)
+ ~kind:`GET ~input:(module Junit) ~output:(module Junit)
(fun () -> reload array) ;
synchronize array ;
install signal (update array) add_update_hook ;
diff --git a/src/plugins/server/states.mli b/src/plugins/server/states.mli
index 00dabb46631f210d561c48e4d168e9dbd87bee7b..3e2c681cb406e8b08cf75a0e218871525f3a9967 100644
--- a/src/plugins/server/states.mli
+++ b/src/plugins/server/states.mli
@@ -22,6 +22,8 @@
(** Synchronized values between Server and Client *)
+open Package
+
type 'a callback = ('a -> unit) -> unit
(** Register a (projectified) value and generates the associated signal and
@@ -37,10 +39,9 @@ type 'a callback = ('a -> unit) -> unit
synchronize with this value.
*)
val register_value :
- page:Doc.page ->
+ package:package ->
name:string ->
descr:Markdown.text ->
- ?details:Markdown.block ->
output:'a Request.output ->
get:(unit -> 'a) ->
?add_hook:(unit callback) ->
@@ -60,10 +61,9 @@ val register_value :
synchronize with this state.
*)
val register_state :
- page:Doc.page ->
+ package:package ->
name:string ->
descr:Markdown.text ->
- ?details:Markdown.block ->
data:'a Data.data ->
get:(unit -> 'a) ->
set:('a -> unit) ->
@@ -78,12 +78,11 @@ val model : unit -> 'a model
(** Populate an array model with a new field.
Columns with name `"id"` and `"_index"` are reserved for internal use. *)
val column :
- model:'a model ->
name:string ->
descr:Markdown.text ->
data:('b Request.output) ->
get:('a -> 'b) ->
- unit -> unit
+ 'a model -> unit
(** Synchronized array state. *)
type 'a array
@@ -121,11 +120,12 @@ val signal : 'a array -> Request.signal
[States.useSyncArray()] hook.
*)
val register_array :
- page:Doc.page ->
+ package:package ->
name:string ->
descr:Markdown.text ->
- ?details:Markdown.block ->
key:('a -> string) ->
+ ?keyName:string ->
+ ?keyKind:string ->
iter:('a callback) ->
?add_update_hook:('a callback) ->
?add_remove_hook:('a callback) ->
diff --git a/src/plugins/server/syntax.ml b/src/plugins/server/syntax.ml
deleted file mode 100644
index 06abe8c24a54612a466b8d5212054e6b640f9010..0000000000000000000000000000000000000000
--- a/src/plugins/server/syntax.ml
+++ /dev/null
@@ -1,158 +0,0 @@
-(**************************************************************************)
-(* *)
-(* This file is part of Frama-C. *)
-(* *)
-(* Copyright (C) 2007-2020 *)
-(* CEA (Commissariat à l'énergie atomique et aux énergies *)
-(* alternatives) *)
-(* *)
-(* you can redistribute it and/or modify it under the terms of the GNU *)
-(* Lesser General Public License as published by the Free Software *)
-(* Foundation, version 2.1. *)
-(* *)
-(* It 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. See the *)
-(* GNU Lesser General Public License for more details. *)
-(* *)
-(* See the GNU Lesser General Public License version 2.1 *)
-(* for more details (enclosed in the file licenses/LGPLv2.1). *)
-(* *)
-(**************************************************************************)
-
-(* -------------------------------------------------------------------------- *)
-
-module Senv = Server_parameters
-
-let check_plugin plugin name =
- let p = String.lowercase_ascii plugin in
- let n = String.lowercase_ascii name in
- let k = String.length plugin in
- if not (String.length name > k &&
- String.sub n 0 k = p &&
- String.get n k = '-')
- then
- Senv.warning ~wkey:Senv.wpage
- "Data %S shall be named « %s-* »"
- name plugin
-
-let check_page page name =
- match Doc.chapter page with
- | `Kernel -> ()
- | `Plugin plugin -> check_plugin plugin name
- | `Protocol -> check_plugin "server" name
-
-let re_name = Str.regexp "[a-z0-9-]+$"
-
-let check_name name =
- if not (Str.string_match re_name name 0) then
- Senv.warning ~wkey:Senv.wname
- "Data name %S is not a dash-separated list of lowercase identifiers" name
-
-(* -------------------------------------------------------------------------- *)
-
-type t = { atomic:bool ; text:Markdown.text }
-
-let atom md = { atomic=true ; text=md }
-let flow md = { atomic=false ; text=md }
-let text { text } = text
-
-let protect a =
- if a.atomic then a.text else Markdown.(plain "(" @ a.text @ plain ")")
-
-let define left right =
- Markdown.(Block_quote [Block[Text ( left @ plain ":=" @ right )]])
-
-let publish ~page ~name ~descr ~synopsis ?(details = []) ?generated () =
- check_name name ;
- check_page page name ;
- let id = Printf.sprintf "data-%s" name in
- let title = Printf.sprintf "`DATA` %s" name in
- let index = [ Printf.sprintf "%s (`DATA`)" name ] in
- let dref = Doc.href page id in
- let dlink = Markdown.href ~text:(Markdown.emph name) dref in
- let data = Markdown.(plain "<" @ dlink @ plain ">") in
- let contents = Markdown.(Block(
- [ Text descr ; define data synopsis.text ]
- )) :: details in
- let _href = Doc.publish ~page ~name:id ~title ~index ~contents ?generated ()
- in atom dlink
-
-(* -------------------------------------------------------------------------- *)
-
-let unit = atom @@ Markdown.code "null"
-let any = atom @@ Markdown.emph "any"
-let int = atom @@ Markdown.emph "int"
-let ident = atom @@ Markdown.emph "ident"
-let string = atom @@ Markdown.emph "string"
-let number = atom @@ Markdown.emph "number"
-let boolean = atom @@ Markdown.emph "boolean"
-let data name dref = atom @@ Markdown.href ~text:(Markdown.emph name) dref
-
-let escaped name =
- Markdown.code (Printf.sprintf "\"%s\"" @@ String.escaped name)
-
-let tag name = atom @@ escaped name
-let array a = atom @@ Markdown.(code "[" @ protect a @ code ", … ]")
-
-let tuple ts =
- atom @@
- Markdown.(
- code "[" @
- glue ~sep:(code ",") (List.map protect ts) @
- code "]"
- )
-
-let union ts = flow @@ Markdown.(glue ~sep:(plain "|") (List.map protect ts))
-
-let option t = atom @@ Markdown.(protect t @ code "?")
-
-(* -------------------------------------------------------------------------- *)
-
-type tag = {
- tag_name : string ;
- tag_label : Markdown.text ;
- tag_descr : Markdown.text ;
-}
-
-let tags ?(title="Tag") (tgs : tag list) =
- let open Markdown in
- let header = [
- plain title, Left;
- plain "Value", Left;
- plain "Description", Left
- ] in
- let row tg = [ tg.tag_label ; escaped tg.tag_name ; tg.tag_descr ] in
- Markdown.Table {
- caption = None ; header ; content = List.map row tgs ;
- }
-
-(* -------------------------------------------------------------------------- *)
-
-let mfield (a,t) = Markdown.( escaped a @ code ":" @ t.text )
-
-let record fds =
- let fields =
- if fds = [] then Markdown.plain "…" else
- Markdown.(glue ~sep:(code ";") (List.map mfield fds))
- in atom @@ Markdown.(code "{" @ fields @ code "}")
-
-type field = {
- fd_name : string ;
- fd_syntax : t ;
- fd_descr : Markdown.text ;
-}
-
-let fields ?(title="Field") (fds : field list) =
- let open Markdown in
- let header = [
- plain title, Left;
- plain "Format", Center;
- plain "Description", Left
- ] in
- let row f = [ escaped f.fd_name ; f.fd_syntax.text ; f.fd_descr ] in
- Markdown.Table {
- caption = None ; header ; content = List.map row fds ;
- }
-
-(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/syntax.mli b/src/plugins/server/syntax.mli
deleted file mode 100644
index 4f7ef4525cd795e1d947c13279a6c9523c9ce512..0000000000000000000000000000000000000000
--- a/src/plugins/server/syntax.mli
+++ /dev/null
@@ -1,78 +0,0 @@
-(**************************************************************************)
-(* *)
-(* This file is part of Frama-C. *)
-(* *)
-(* Copyright (C) 2007-2020 *)
-(* CEA (Commissariat à l'énergie atomique et aux énergies *)
-(* alternatives) *)
-(* *)
-(* you can redistribute it and/or modify it under the terms of the GNU *)
-(* Lesser General Public License as published by the Free Software *)
-(* Foundation, version 2.1. *)
-(* *)
-(* It 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. See the *)
-(* GNU Lesser General Public License for more details. *)
-(* *)
-(* See the GNU Lesser General Public License version 2.1 *)
-(* for more details (enclosed in the file licenses/LGPLv2.1). *)
-(* *)
-(**************************************************************************)
-
-(* -------------------------------------------------------------------------- *)
-(** JSON Encoding Documentation *)
-(* -------------------------------------------------------------------------- *)
-
-type t
-
-val text : t -> Markdown.text
-
-(** The provided synopsis must be very short, to fit in one line.
- Extended definition, like record fields and such, must be detailed in
- the description block. *)
-val publish :
- page:Doc.page -> name:string -> descr:Markdown.text ->
- synopsis:t ->
- ?details:Markdown.elements ->
- ?generated:(unit -> Markdown.elements) ->
- unit -> t
-
-val unit : t
-val any : t
-val int : t (* small, non-decimal, number *)
-val ident : t (* integer of string *)
-val string : t
-val number : t
-val boolean : t
-
-val tag : string -> t
-val array : t -> t
-val tuple : t list -> t
-val union : t list -> t
-val option : t -> t
-val record : (string * t) list -> t
-val data : string -> Markdown.href -> t
-
-type tag = {
- tag_name : string ;
- tag_label : Markdown.text ;
- tag_descr : Markdown.text ;
-}
-
-(** Syntactic definition: LEFT := RIGHT *)
-val define : Markdown.text -> Markdown.text -> Markdown.block_element
-
-(** Builds a table with tags description.
- The [~title] is applied to the tag name column
- (shall be capitalized, defaults to ["Tag"]). *)
-val tags : ?title:string -> tag list -> Markdown.element
-
-type field = { fd_name : string ; fd_syntax : t ; fd_descr : Markdown.text }
-
-(** Builds a table with fields description.
- The [~title] is applied to the field name column
- (shall be capitalized, defaults to ["Field"]). *)
-val fields : ?title:string -> field list -> Markdown.element
-
-(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/tests/batch/ast_services.json b/src/plugins/server/tests/batch/ast_services.json
index 0d2f49866478c4021c69f4a57a77c383db2939ba..a3c7130c2166d4ac44d8a4adb32fc7640747c4bd 100644
--- a/src/plugins/server/tests/batch/ast_services.json
+++ b/src/plugins/server/tests/batch/ast_services.json
@@ -1,6 +1,6 @@
[
- { id:"GET-1", request:"kernel.ast.functions.fetch", data:5 },
- { id:"GET-2", request:"kernel.ast.functions.fetch", data:5 },
+ { id:"GET-1", request:"kernel.ast.fetchFunctions", data:5 },
+ { id:"GET-2", request:"kernel.ast.fetchFunctions", data:5 },
{ id:"PRINT-F", request:"kernel.ast.printFunction", data:"f" },
{ id:"PRINT-G", request:"kernel.ast.printFunction", data:"g" },
{ id:"PRINT-H", request:"kernel.ast.printFunction", data:"h" }
diff --git a/src/plugins/server/tests/batch/kernel_services.json b/src/plugins/server/tests/batch/kernel_services.json
index 5b58c627bfe01240de30931928d88a35352fbc83..395afbd860fca909c20baa1f245ec2a6b050fc02 100644
--- a/src/plugins/server/tests/batch/kernel_services.json
+++ b/src/plugins/server/tests/batch/kernel_services.json
@@ -1,4 +1,4 @@
[
- { id:"getLogs", request:"kernel.getLogs", data:null },
- { id:"setLogs", request:"kernel.setLogs", data:false }
-]
\ No newline at end of file
+ { id:"getLogs", request:"kernel.services.getLogs", data:null },
+ { id:"setLogs", request:"kernel.services.setLogs", data:false }
+]
diff --git a/src/plugins/server/tests/batch/oracle/ast_services.res.oracle b/src/plugins/server/tests/batch/oracle/ast_services.res.oracle
index 26538ad6f7676ad34e6cf81f4063f17dc09ce046..a8f90aa0a6d671e36dba1e3b22545359a61e4a4e 100644
--- a/src/plugins/server/tests/batch/oracle/ast_services.res.oracle
+++ b/src/plugins/server/tests/batch/oracle/ast_services.res.oracle
@@ -1,7 +1,7 @@
[kernel] Parsing tests/batch/ast_services.i (no preprocessing)
[server] Script "tests/batch/ast_services.json"
-[server] [GET] kernel.ast.functions.fetch
-[server] [GET] kernel.ast.functions.fetch
+[server] [GET] kernel.ast.fetchFunctions
+[server] [GET] kernel.ast.fetchFunctions
[server] [GET] kernel.ast.printFunction
[server] [GET] kernel.ast.printFunction
[server] [GET] kernel.ast.printFunction
diff --git a/src/plugins/server/tests/batch/oracle/kernel_services.res.oracle b/src/plugins/server/tests/batch/oracle/kernel_services.res.oracle
index 7e1c091eeec6f5d3fdd51a5d05c677f0e1fee812..ac2abc0997009d1b6ec051d377c7addf128a0698 100644
--- a/src/plugins/server/tests/batch/oracle/kernel_services.res.oracle
+++ b/src/plugins/server/tests/batch/oracle/kernel_services.res.oracle
@@ -1,5 +1,5 @@
[kernel] Parsing tests/batch/kernel_services.i (no preprocessing)
[server] Script "tests/batch/kernel_services.json"
-[server] [GET] kernel.getLogs
-[server] [SET] kernel.setLogs
+[server] [GET] kernel.services.getLogs
+[server] [SET] kernel.services.setLogs
[server] Output "tests/batch/result/kernel_services.out.json"
diff --git a/src/plugins/value/Eva.mli b/src/plugins/value/Eva.mli
index 4de6198ed1a43b3c1d4a9c2d0a344b378eee5dc6..a11a0dca9aa2bab2ab56cfc918b2dbb915cd0c8e 100644
--- a/src/plugins/value/Eva.mli
+++ b/src/plugins/value/Eva.mli
@@ -60,3 +60,9 @@ module Eval_terms: sig
@return None on either an evaluation error or on unsupported construct. *)
val predicate_deps: eval_env -> Cil_types.predicate -> logic_deps option
end
+
+
+module Unit_tests: sig
+ (** Runs the unit tests of Eva. *)
+ val run: unit -> unit
+end
diff --git a/src/plugins/value/api/general_requests.ml b/src/plugins/value/api/general_requests.ml
index 1b2c3a0c1c1f49b6e281b37818a24c83b546f543..5c30a704fbcb1fc5e59c9b7bbcf611adc6091460 100644
--- a/src/plugins/value/api/general_requests.ml
+++ b/src/plugins/value/api/general_requests.ml
@@ -22,8 +22,8 @@
open Server
-let chapter = `Plugin "Eva"
-let page = Doc.page chapter ~title:"Eva general services" ~filename:"eva.md"
+let package = Package.package ~plugin:"eva"
+ ~title:"Eva General Services" ~readme:"eva.md" ()
module CallSite = Data.Jpair (Kernel_ast.Kf) (Kernel_ast.Stmt)
@@ -31,8 +31,10 @@ let callers kf =
let list = !Db.Value.callers kf in
List.concat (List.map (fun (kf, l) -> List.map (fun s -> kf, s) l) list)
-let () = Request.register ~page
- ~kind:`GET ~name:"eva.callers"
+let () = Request.register ~package
+ ~kind:`GET ~name:"getCallers"
~descr:(Markdown.plain "Get the list of call site of a function")
~input:(module Kernel_ast.Kf) ~output:(module Data.Jlist (CallSite))
callers
+
+(**************************************************************************)
diff --git a/src/plugins/value/utils/unit_tests.ml b/src/plugins/value/utils/unit_tests.ml
new file mode 100644
index 0000000000000000000000000000000000000000..043a2a726fa93a52dba15278fa6a4ca2881935e0
--- /dev/null
+++ b/src/plugins/value/utils/unit_tests.ml
@@ -0,0 +1,135 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+open Cil_types
+
+(* If true, prints each operation performed for the tests. Otherwise, only
+ prints wrong operations. *)
+let print = false
+
+let report bug format =
+ if print || bug
+ then Value_parameters.result ("%s" ^^ format) (if bug then "BUG " else "")
+ else Format.ifprintf Format.std_formatter format
+
+
+(* Tests the semantics of sign values, by comparison with the Ival semantics. *)
+module Sign = struct
+
+ module Sign = struct
+ include Sign_value
+ let zero = zero
+ let pos = one
+ let neg = inject_int Cil.uintType Integer.minus_one
+ let pos_or_zero = join zero pos
+ let neg_or_zero = join zero neg
+ let pos_neg = join pos neg
+ end
+
+ module Ival = struct
+ include Ival
+ let positive = inject_range (Some Integer.one) None
+ let negative = inject_range None (Some Integer.minus_one)
+ let pos irange =
+ let max = Eval_typ.range_upper_bound irange in
+ inject_range (Some Integer.one) (Some max)
+ let neg irange =
+ let min = Eval_typ.range_lower_bound irange in
+ inject_range (Some min) (Some Integer.minus_one)
+ end
+
+ module Cval = Main_values.CVal
+
+ (* List of pairs (ival, sign) such that γ(ival) ⊆ γ(sign) and all values in
+ γ(sign) are in the range of [ikind]. *)
+ let test_values ikind =
+ let irange = Eval_typ.ik_range ikind in
+ let list =
+ [ Ival.zero, Sign.zero;
+ Ival.pos irange, Sign.pos;
+ Ival.zero, Sign.pos_or_zero;
+ Ival.pos irange, Sign.pos_or_zero; ]
+ in
+ if not irange.Eval_typ.i_signed
+ then list
+ else
+ list @
+ [ Ival.neg irange, Sign.neg;
+ Ival.zero, Sign.neg_or_zero;
+ Ival.neg irange, Sign.neg_or_zero;
+ Ival.pos irange, Sign.pos_neg;
+ Ival.neg irange, Sign.pos_neg; ]
+
+ let make_cvalue values =
+ List.map (fun (ival, sign) -> Cvalue.V.inject_ival ival, sign) values
+
+ (* Checks whether γ(ival) ⊆ γ(sign). *)
+ let is_included cvalue sign =
+ try
+ let ival = Cvalue.V.project_ival cvalue in
+ (not (Ival.contains_zero ival) || sign.Sign.zero) &&
+ (Ival.(is_bottom (narrow ival positive)) || sign.Sign.pos) &&
+ (Ival.(is_bottom (narrow ival negative)) || sign.Sign.neg)
+ with Cvalue.V.Not_based_on_null -> Sign.(equal sign top)
+
+ let test_unop unop typ values =
+ let test (cval, sign) =
+ let cval_res = Cval.forward_unop typ unop cval in
+ let sign_res = Sign.forward_unop typ unop sign in
+ let bug = not (Bottom.is_included is_included cval_res sign_res) in
+ report bug "%a %a = %a while %a %a = %a"
+ Printer.pp_unop unop Cval.pretty cval (Bottom.pretty Cval.pretty) cval_res
+ Printer.pp_unop unop Sign.pretty sign (Bottom.pretty Sign.pretty) sign_res
+ in
+ List.iter test values
+
+ let test_binop binop typ values =
+ let test (cval1, sign1) (cval2, sign2) =
+ let cval_res = Cval.forward_binop typ binop cval1 cval2 in
+ let sign_res = Sign.forward_binop typ binop sign1 sign2 in
+ let bug = not (Bottom.is_included is_included cval_res sign_res) in
+ report bug "%a %a %a = %a while %a %a %a = %a"
+ Cval.pretty cval1 Printer.pp_binop binop Cval.pretty cval2
+ (Bottom.pretty Cval.pretty) cval_res
+ Sign.pretty sign1 Printer.pp_binop binop Sign.pretty sign2
+ (Bottom.pretty Sign.pretty) sign_res
+ in
+ List.iter (fun x -> List.iter (test x) values) values
+
+ let test_typ ikind =
+ let typ = TInt (ikind, [])
+ and values = make_cvalue (test_values ikind) in
+ let apply f op = f op typ values in
+ List.iter (apply test_unop) [Neg; BNot; LNot];
+ List.iter (apply test_binop)
+ [PlusA; MinusA; Mult; Div; BAnd; BOr; BXor; LAnd; LOr]
+
+ let test () = List.iter test_typ [IInt; IUInt]
+end
+
+(** Runs all tests. *)
+let run () =
+ Value_parameters.result "Runs unit tests: %s."
+ (if print
+ then "all operations will be printed"
+ else "only faulty operations will be printed");
+ Sign.test ()
diff --git a/src/plugins/value/utils/unit_tests.mli b/src/plugins/value/utils/unit_tests.mli
new file mode 100644
index 0000000000000000000000000000000000000000..8783260b33accee3d55c8edf0a5002e41d3ed89b
--- /dev/null
+++ b/src/plugins/value/utils/unit_tests.mli
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(** Currently tested by this file:
+ - semantics of sign values. *)
+
+(** Runs some programmatic tests on Eva. *)
+val run: unit -> unit
diff --git a/src/plugins/value/values/cvalue_forward.ml b/src/plugins/value/values/cvalue_forward.ml
index 6822e5f5a5c0218144b3776f9d489431f8c63b9e..91263cb385821059a3a9b72b50ad514a788a35f0 100644
--- a/src/plugins/value/values/cvalue_forward.ml
+++ b/src/plugins/value/values/cvalue_forward.ml
@@ -28,28 +28,54 @@ open Abstract_value
Comparison
-------------------------------------------------------------------------- *)
+(* Representation of a pointer value to a literal string, with the string
+ itself, its length and the offsets pointed to in the string. *)
+type str = { string: string; offset: Ival.t; length: int; }
+
+(* Returns true if one string is a suffix of the other, and if there are offsets
+ pointing to the same point in this suffix. *)
+let may_be_suffix s1 s2 =
+ (* Requires [s1.length] <= [s2.length]. *)
+ let is_suffix s1 s2 =
+ let sub2 = String.sub s2.string (s2.length - s1.length) s1.length in
+ String.equal s1.string sub2 &&
+ let delta = Integer.of_int (s1.length - s2.length) in
+ let off2 = Ival.add_singleton_int delta s2.offset in
+ not (Ival.is_bottom (Ival.narrow s1.offset off2))
+ in
+ if s1.length <= s2.length then is_suffix s1 s2 else is_suffix s2 s1
+
+(* Returns true if [s1] may be shared with [s2] or a substring of [s2]. *)
+let rec may_be_shared_within s1 s2 =
+ may_be_suffix s1 s2 ||
+ match String.rindex_opt s2.string '\x00' with
+ | None -> false
+ | Some i ->
+ let s2 = { s2 with string = String.sub s2.string 0 i; length = i } in
+ may_be_shared_within s1 s2
+
+(* Returns true if [s1] and [s2] might point to the same literal string. *)
+let may_be_shared str1 off1 str2 off2 =
+ let s1 = { string = str1; offset = off1; length = String.length str1 }
+ and s2 = { string = str2; offset = off2; length = String.length str2 } in
+ may_be_shared_within s1 s2 || may_be_shared_within s2 s1
+
+(* Checks if all string bases of [v] satisfy [f]. *)
+let for_all_string v f =
+ Locations.Location_Bytes.for_all
+ (fun base off -> match base with
+ | Base.String (_, Base.CSString str) -> f base str off
+ | Base.String (_, Base.CSWstring _ ) -> false (* Not implemented yet *)
+ | _ -> true)
+ v
+
(* Literal strings can only be compared if their contents are recognizably
different (or the strings are physically the same). *)
-let are_comparable_string pointer1 pointer2 =
- try
- Locations.Location_Bytes.iter_on_strings ~skip:None
- (fun base1 s1 offs1 len1 ->
- Locations.Location_Bytes.iter_on_strings ~skip:(Some base1)
- (fun _ s2 offs2 len2 ->
- let delta = offs1 - offs2 in
- let start = if delta <= 0 then -delta else 0
- and max = min len2 (len1 - delta) in
- let length = max - start + 1 in
- let sub1 = String.sub s1 (start + delta) length
- and sub2 = String.sub s2 start length in
- if String.compare sub1 sub2 = 0
- then raise Not_found)
- pointer1)
- pointer2;
- true
- with
- | Not_found -> false
- | Invalid_argument _s -> assert false
+let are_comparable_string v1 v2 =
+ for_all_string v1 (fun base1 str1 off1 ->
+ for_all_string v2 (fun base2 str2 off2 ->
+ Base.equal base1 base2 ||
+ not (may_be_shared str1 off1 str2 off2)))
(* Under-approximation of the fact that a pointer is actually correct w.r.t.
what can be created through pointer arithmetics. See C99 6.5.6 and 6.5.8
diff --git a/src/plugins/value/values/sign_value.ml b/src/plugins/value/values/sign_value.ml
index 74c45a2c26862947e8909f5d0997dbf695722b5a..93051f60d086a6613c33d8327a049d52343fb9f8 100644
--- a/src/plugins/value/values/sign_value.ml
+++ b/src/plugins/value/values/sign_value.ml
@@ -125,17 +125,28 @@ let assume_comparable _ v1 v2 = `Unknown (v1, v2)
(** {2 Forward transfer functions} *)
-(* The three functions below are forward transformers for the mathematical
- operations +, *, /, and the unary negation -. The potential overflows for the
- operations on machine integers are taken into account by the functions
- [truncate_integer] and [rewrap_integer]. *)
+(* Functions [neg_unop], [plus], [mul] and [div] below are forward transformers
+ for the mathematical operations -, +, *, /. The potential overflows and
+ wrappings for the operations on machine integers are taken into account by
+ the functions [truncate_integer] and [rewrap_integer]. *)
let neg_unop v = { v with neg = v.pos; pos = v.neg }
-let forward_unop _ op v =
+let bitwise_not typ v =
+ match Cil.unrollType typ with
+ | TInt (ikind, _) | TEnum ({ekind=ikind}, _) ->
+ if Cil.isSigned ikind
+ then { pos = v.neg; neg = v.pos || v.zero; zero = v.neg }
+ else { pos = v.pos || v.zero; neg = false; zero = v.pos }
+ | _ -> top
+
+let logical_not v = { pos = v.zero; neg = false; zero = v.pos || v.neg }
+
+let forward_unop typ op v =
match op with
| Neg -> `Value (neg_unop v)
- | _ -> `Value top
+ | BNot -> `Value (bitwise_not typ v)
+ | LNot -> `Value (logical_not v)
let plus v1 v2 =
let neg = v1.neg || v2.neg in
@@ -158,12 +169,69 @@ let div v1 v2 =
let zero = true in (* zero can appear with large enough v2 *)
{ neg; pos; zero }
+(* The implementation of the bitwise operators below relies on this table
+ giving the sign of the result according to the sign of both operands.
+
+ v1 v2 v1&v2 v1|v2 v1^v2
+ -----------------------------------
+ | + + +0 + +0
+ | + 0 0 + +
+ | + - +0 - -
+ | 0 + 0 + +
+ | 0 0 0 0 0
+ | 0 - 0 - -
+ | - + +0 - -
+ | - 0 0 - -
+ | - - - - +0
+*)
+
+let bitwise_and v1 v2 =
+ let pos = (v1.pos && (v2.pos || v2.neg)) || (v2.pos && v1.neg) in
+ let neg = v1.neg && v2.neg in
+ let zero = v1.zero || v1.pos || v2.zero || v2.pos in
+ { neg; pos; zero }
+
+let bitwise_or v1 v2 =
+ let pos = (v1.pos && (v2.pos || v2.zero)) || (v1.zero && v2.pos) in
+ let neg = v1.neg || v2.neg in
+ let zero = v1.zero && v2.zero in
+ { neg; pos; zero }
+
+let bitwise_xor v1 v2 =
+ let pos =
+ (v1.pos && v2.pos) || (v1.pos && v2.zero) || (v1.zero && v2.pos)
+ || (v1.neg && v2.neg)
+ in
+ let neg =
+ (v1.neg && (v2.pos || v2.zero)) ||
+ (v2.neg && (v1.pos || v1.zero))
+ in
+ let zero = (v1.zero && v2.zero) || (v1.pos && v2.pos) || (v1.neg && v2.neg) in
+ { neg; pos; zero }
+
+let logical_and v1 v2 =
+ let pos = (v1.pos || v1.neg) && (v2.pos || v2.neg) in
+ let neg = false in
+ let zero = v1.zero || v2.zero in
+ { pos; neg; zero }
+
+let logical_or v1 v2 =
+ let pos = v1.pos || v1.neg || v2.pos || v2.neg in
+ let neg = false in
+ let zero = v1.zero && v2.zero in
+ { pos; neg; zero }
+
let forward_binop _ op v1 v2 =
match op with
| PlusA -> `Value (plus v1 v2)
| MinusA -> `Value (plus v1 (neg_unop v2))
| Mult -> `Value (mul v1 v2)
| Div -> if equal zero v2 then `Bottom else `Value (div v1 v2)
+ | BAnd -> `Value (bitwise_and v1 v2)
+ | BOr -> `Value (bitwise_or v1 v2)
+ | BXor -> `Value (bitwise_xor v1 v2)
+ | LAnd -> `Value (logical_and v1 v2)
+ | LOr -> `Value (logical_or v1 v2)
| _ -> `Value top
let rewrap_integer range v =
diff --git a/src/plugins/value/values/sign_value.mli b/src/plugins/value/values/sign_value.mli
index 055794019f7c3ace0d52ffd9652037f60c978d4e..94dd0faa8383c843fc97a7e8093f992c51f74bd5 100644
--- a/src/plugins/value/values/sign_value.mli
+++ b/src/plugins/value/values/sign_value.mli
@@ -22,6 +22,12 @@
(** Sign domain: abstraction of integer numerical values by their signs. *)
-include Abstract_value.Leaf
+type signs = {
+ pos: bool; (** true: maybe positive, false: never positive *)
+ zero: bool; (** true: maybe zero, false: never zero *)
+ neg: bool; (** true: maybe negative, false: never negative *)
+}
+
+include Abstract_value.Leaf with type t = signs
val pretty_debug: t Pretty_utils.formatter
diff --git a/src/plugins/wp/Cache.ml b/src/plugins/wp/Cache.ml
new file mode 100644
index 0000000000000000000000000000000000000000..d08034e93ca7bd84a44ba06bb4d5b340ad474e75
--- /dev/null
+++ b/src/plugins/wp/Cache.ml
@@ -0,0 +1,288 @@
+(**************************************************************************)
+(* *)
+(* This file is part of WP plug-in of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat a l'energie atomique et aux energies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Cache Management --- *)
+(* -------------------------------------------------------------------------- *)
+
+type mode = NoCache | Update | Replay | Rebuild | Offline | Cleanup
+
+let hits = ref 0
+let miss = ref 0
+let removed = ref 0
+let cleanup = Hashtbl.create 0
+(* used entries, never to be reset since cleanup is performed at exit *)
+
+let get_hits () = !hits
+let get_miss () = !miss
+let get_removed () = !removed
+
+let mark_cache ~mode hash =
+ if mode = Cleanup || !Fc_config.is_gui then Hashtbl.replace cleanup hash ()
+
+module CACHEDIR = WpContext.StaticGenerator(Datatype.Unit)
+ (struct
+ type key = unit
+ type data = Filepath.Normalized.t
+ let name = "Wp.Cache.dir"
+ let compile () =
+ try
+ if not (Wp_parameters.CacheEnv.get()) then
+ raise Not_found ;
+ let gdir = Sys.getenv "FRAMAC_WP_CACHEDIR" in
+ if gdir = "" then raise Not_found ;
+ Filepath.Normalized.of_string gdir
+ with Not_found ->
+ try
+ let gdir = Wp_parameters.CacheDir.get() in
+ if gdir = "" then raise Not_found ;
+ Filepath.Normalized.of_string gdir
+ with Not_found ->
+ Wp_parameters.get_session_dir ~force:false "cache"
+ end)
+
+let get_dir () = (CACHEDIR.get () :> string)
+
+let is_session_dir path =
+ 0 = Filepath.Normalized.compare
+ path (Wp_parameters.get_session_dir ~force:false "cache")
+
+let get_usable_dir ?(make=false) () =
+ let path = CACHEDIR.get () in
+ let parents = is_session_dir path in
+ let path = (path :> string) in
+ if not (Sys.file_exists path) && make then
+ Extlib.mkdir ~parents path 0o755 ;
+ if not (Sys.is_directory path) then begin
+ Wp_parameters.warning ~current:false ~once:true
+ "Cache path is not a directory" ;
+ raise Not_found
+ end ;
+ path
+
+let has_dir () =
+ try
+ if not (Wp_parameters.CacheEnv.get()) then
+ raise Not_found ;
+ Sys.getenv "FRAMAC_WP_CACHEDIR" <> ""
+ with Not_found -> Wp_parameters.CacheDir.get () <> ""
+
+let is_global_cache () = Wp_parameters.CacheDir.get () <> ""
+
+(* -------------------------------------------------------------------------- *)
+(* --- Cache Management --- *)
+(* -------------------------------------------------------------------------- *)
+
+let parse_mode ~origin ~fallback = function
+ | "none" -> NoCache
+ | "update" -> Update
+ | "replay" -> Replay
+ | "rebuild" -> Rebuild
+ | "offline" -> Offline
+ | "cleanup" -> Cleanup
+ | "" -> raise Not_found
+ | m ->
+ Wp_parameters.warning ~current:false
+ "Unknown %s mode %S (use %s instead)" origin m fallback ;
+ raise Not_found
+
+let mode_name = function
+ | NoCache -> "none"
+ | Update -> "update"
+ | Replay -> "replay"
+ | Rebuild -> "rebuild"
+ | Offline -> "offline"
+ | Cleanup -> "cleanup"
+
+module MODE = WpContext.StaticGenerator(Datatype.Unit)
+ (struct
+ type key = unit
+ type data = mode
+ let name = "Wp.Cache.mode"
+ let compile () =
+ try
+ if not (Wp_parameters.CacheEnv.get()) then
+ raise Not_found ;
+ let origin = "FRAMAC_WP_CACHE" in
+ parse_mode ~origin ~fallback:"-wp-cache" (Sys.getenv origin)
+ with Not_found ->
+ try
+ let mode = Wp_parameters.Cache.get() in
+ parse_mode ~origin:"-wp-cache" ~fallback:"none" mode
+ with Not_found ->
+ if Wp_parameters.has_session () || has_dir ()
+ then Update else NoCache
+ end)
+
+let get_mode = MODE.get
+let set_mode m = MODE.clear () ; Wp_parameters.Cache.set (mode_name m)
+
+let task_hash wpo drv prover task =
+ lazy
+ begin
+ let file = Wpo.DISK.file_goal
+ ~pid:wpo.Wpo.po_pid
+ ~model:wpo.Wpo.po_model
+ ~prover:(VCS.Why3 prover) in
+ let _ = Command.print_file file
+ begin fun fmt ->
+ Format.fprintf fmt "(* WP Task for Prover %s *)@\n"
+ (Why3Provers.print_why3 prover) ;
+ Why3.Driver.print_task_prepared drv fmt task ;
+ end
+ in Digest.file file |> Digest.to_hex
+ end
+
+let time_fits time = function
+ | None | Some 0 -> true
+ | Some limit -> time <= float limit
+
+let steps_fits steps = function
+ | None | Some 0 -> true
+ | Some limit -> steps <= limit
+
+let time_seized time = function
+ | None | Some 0 -> false
+ | Some limit -> float limit <= time
+
+let steps_seized steps steplimit =
+ steps <> 0 &&
+ match steplimit with
+ | None | Some 0 -> false
+ | Some limit -> limit <= steps
+
+let promote ~timeout ~steplimit (res : VCS.result) =
+ match res.verdict with
+ | VCS.NoResult | VCS.Computing _ -> VCS.no_result
+ | VCS.Failed -> res
+ | VCS.Invalid | VCS.Valid | VCS.Unknown ->
+ if not (steps_fits res.prover_steps steplimit) then
+ { res with verdict = Stepout }
+ else
+ if not (time_fits res.prover_time timeout) then
+ { res with verdict = Timeout }
+ else res
+ | VCS.Timeout | VCS.Stepout ->
+ if steps_seized res.prover_steps steplimit then
+ { res with verdict = Stepout }
+ else
+ if time_seized res.prover_time timeout then
+ { res with verdict = Timeout }
+ else (* can be run a longer time or widely *)
+ VCS.no_result
+
+let get_cache_result ~mode hash =
+ match mode with
+ | NoCache | Rebuild -> VCS.no_result
+ | Update | Cleanup | Replay | Offline ->
+ try
+ let dir = get_usable_dir ~make:true () in
+ let hash = Lazy.force hash in
+ let file = Printf.sprintf "%s/%s.json" dir hash in
+ if not (Sys.file_exists file) then VCS.no_result
+ else
+ try
+ mark_cache ~mode hash ;
+ Json.load_file file |> ProofScript.result_of_json
+ with err ->
+ Wp_parameters.warning ~current:false ~once:true
+ "invalid cache entry (%s)" (Printexc.to_string err) ;
+ VCS.no_result
+ with Not_found -> VCS.no_result
+
+let set_cache_result ~mode hash prover result =
+ match mode with
+ | NoCache | Replay | Offline -> ()
+ | Rebuild | Update | Cleanup ->
+ let hash = Lazy.force hash in
+ try
+ let dir = get_usable_dir ~make:true () in
+ let file = Printf.sprintf "%s/%s.json" dir hash in
+ mark_cache ~mode hash ;
+ ProofScript.json_of_result (VCS.Why3 prover) result
+ |> Json.save_file file
+ with err ->
+ Wp_parameters.warning ~current:false ~once:true
+ "can not update cache (%s)" (Printexc.to_string err)
+
+let cleanup_cache () =
+ let mode = get_mode () in
+ if mode = Cleanup && (!hits > 0 || !miss > 0) then
+ try
+ let dir = get_usable_dir () in
+ if is_global_cache () then
+ Wp_parameters.warning ~current:false ~once:true
+ "Cleanup mode deactivated with global cache."
+ else
+ Array.iter
+ (fun f ->
+ if Filename.check_suffix f ".json" then
+ let hash = Filename.chop_suffix f ".json" in
+ if not (Hashtbl.mem cleanup hash) then
+ begin
+ incr removed ;
+ Extlib.safe_remove (Printf.sprintf "%s/%s" dir f) ;
+ end
+ ) (Sys.readdir dir) ;
+ with
+ | Unix.Unix_error _ as exn ->
+ Wp_parameters.warning ~current:false
+ "Can not cleanup cache (%s)" (Printexc.to_string exn)
+ | Not_found ->
+ Wp_parameters.warning ~current:false
+ "Cannot cleanup cache"
+
+type runner =
+ timeout:int option -> steplimit:int option ->
+ Why3.Driver.driver -> Why3Provers.t -> Why3.Task.task ->
+ VCS.result Task.task
+
+let get_result wpo runner ~timeout ~steplimit drv prover task =
+ let mode = get_mode () in
+ match mode with
+ | NoCache ->
+ runner ~timeout ~steplimit drv prover task
+ | Offline ->
+ let hash = task_hash wpo drv prover task in
+ let result = get_cache_result ~mode hash |> VCS.cached in
+ if VCS.is_verdict result then incr hits else incr miss ;
+ Task.return result
+ | Update | Replay | Rebuild | Cleanup ->
+ let hash = task_hash wpo drv prover task in
+ let result =
+ get_cache_result ~mode hash
+ |> promote ~timeout ~steplimit |> VCS.cached in
+ if VCS.is_verdict result
+ then
+ begin
+ incr hits ;
+ Task.return result
+ end
+ else
+ Task.finally
+ (runner ~timeout ~steplimit drv prover task)
+ begin function
+ | Task.Result result when VCS.is_verdict result ->
+ incr miss ;
+ set_cache_result ~mode hash prover result
+ | _ -> ()
+ end
diff --git a/src/plugins/wp/Cache.mli b/src/plugins/wp/Cache.mli
new file mode 100644
index 0000000000000000000000000000000000000000..39af510514147e3d227b1a69b7b02ca38789e2b9
--- /dev/null
+++ b/src/plugins/wp/Cache.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(* *)
+(* This file is part of WP plug-in of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2020 *)
+(* CEA (Commissariat a l'energie atomique et aux energies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It 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. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(* *)
+(**************************************************************************)
+
+type mode = NoCache | Update | Replay | Rebuild | Offline | Cleanup
+
+val get_dir : unit -> string
+
+val set_mode : mode -> unit
+val get_mode : unit -> mode
+val get_hits : unit -> int
+val get_miss : unit -> int
+val get_removed : unit -> int
+
+val cleanup_cache : unit -> unit
+
+type runner =
+ timeout:int option -> steplimit:int option ->
+ Why3.Driver.driver -> Why3Provers.t -> Why3.Task.task ->
+ VCS.result Task.task
+
+val get_result: Wpo.t -> runner -> runner
diff --git a/src/plugins/wp/Changelog b/src/plugins/wp/Changelog
index 33d00e5c2bc3331d2648273f5dd6979ecebd4099..7f362c7148689ecbbdda1696585c2a3fd53b0e65 100644
--- a/src/plugins/wp/Changelog
+++ b/src/plugins/wp/Changelog
@@ -24,7 +24,10 @@
Plugin WP <next-release>
#########################
-- WP [2020-06-12] Supports the \initialized ACSL predicate
+- WP [2020-07-06] Removed debug keys "no-xxx-info" (subsumed by "shell")
+- WP [2020-07-06] Option -wp-cache-env now defaults to false
+- WP [2020-07-06] New option -wp-cache-print
+- WP [2020-06-12] Supports the \initialized ACSL predicate
#########################
Plugin WP 21.1 (Scandium)
diff --git a/src/plugins/wp/GuiPanel.ml b/src/plugins/wp/GuiPanel.ml
index 75cda8679784d9b0c40266bd0200fd7cdb72c8c1..b24a0ca165b0113a6afb5761142d6c86f4eb22f2 100644
--- a/src/plugins/wp/GuiPanel.ml
+++ b/src/plugins/wp/GuiPanel.ml
@@ -224,14 +224,14 @@ let wp_panel
hbox#pack prover_cfg#coerce ;
Gtk_form.menu [
- "No Cache" , ProverWhy3.NoCache ;
- "Update" , ProverWhy3.Update ;
- "Cleanup" , ProverWhy3.Cleanup ;
- "Rebuild" , ProverWhy3.Rebuild ;
- "Replay" , ProverWhy3.Replay ;
- "Offline" , ProverWhy3.Offline ;
+ "No Cache" , Cache.NoCache ;
+ "Update" , Cache.Update ;
+ "Cleanup" , Cache.Cleanup ;
+ "Rebuild" , Cache.Rebuild ;
+ "Replay" , Cache.Replay ;
+ "Offline" , Cache.Offline ;
] ~packing:hbox#pack ~tooltip:"Proof Cache Mode"
- ProverWhy3.get_mode ProverWhy3.set_mode demon ;
+ Cache.get_mode Cache.set_mode demon ;
let pbox = GPack.hbox ~packing ~show:false () in
let progress = GRange.progress_bar ~packing:(pbox#pack ~expand:true ~fill:true) () in
diff --git a/src/plugins/wp/Lang.ml b/src/plugins/wp/Lang.ml
index d8bbb4231bb2d648c5a755474fc69a7bcd01fc35..43f7709a6ac2a16f7bc8a6fb93d99c01970566d4 100644
--- a/src/plugins/wp/Lang.ml
+++ b/src/plugins/wp/Lang.ml
@@ -165,8 +165,8 @@ let ext_compare a b = Datatype.Int.compare a.ext_id b.ext_id
let sort_of_object = function
| C_int _ -> Logic.Sint
- | C_float _ -> Logic.Sreal
| C_pointer _ | C_comp _ | C_array _ -> Logic.Sdata
+ | C_float f -> Qed.Kind.of_tau (Context.get floats f)
let init_sort_of_object = function
| C_int _ | C_float _ | C_pointer _ -> Logic.Sbool
diff --git a/src/plugins/wp/Makefile.in b/src/plugins/wp/Makefile.in
index 05e547e21821031a3d31d0ae3c9b57739f3ebc3e..dc8b2c99ecea03e5415df621ca826a3db8c40aeb 100644
--- a/src/plugins/wp/Makefile.in
+++ b/src/plugins/wp/Makefile.in
@@ -93,7 +93,7 @@ PLUGIN_CMO:= \
TacCongruence TacOverflow Auto \
ProofSession ProofScript ProofEngine \
ProverTask ProverErgo ProverCoq \
- filter_axioms ProverWhy3 \
+ filter_axioms Cache ProverWhy3 \
driver prover ProverSearch ProverScript \
Generator Factory \
calculus cfgDump cfgWP \
@@ -169,19 +169,23 @@ $(Wp_DIR)/Makefile: $(WP_CONFIGURE_MAKEFILE)
WP_QUALIF_CACHE?=$(abspath $(Wp_DIR)/../wp-cache)
WP_QUALIF_ENTRIES=git -C $(WP_QUALIF_CACHE) ls-files --others --exclude-standard | wc -l
+WP_CHECKOUT_CACHE=\
+ echo "[CACHE] repo: $(WP_QUALIF_CACHE)" && \
+ git -C $(WP_QUALIF_CACHE) checkout master
+
wp-qualif: ./bin/toplevel.opt ./bin/ptests.opt $(WP_QUALIF_CACHE)
+ $(WP_CHECKOUT_CACHE)
FRAMAC_WP_CACHE=replay \
FRAMAC_WP_CACHEDIR=$(WP_QUALIF_CACHE) \
./bin/ptests.opt src/plugins/wp/tests -config qualif -error-code
-wp-qualif-env:
- echo "FRAMAC_WP_CACHE=update"
- echo "FRAMAC_WP_CACHEDIR=$(WP_QUALIF_CACHE)"
+WP_PULL_CACHE=\
+ echo "[CACHE] pull cache" && \
+ $(WP_CHECKOUT_CACHE) && \
+ git -C $(WP_QUALIF_CACHE) pull --rebase --prune
wp-qualif-update: ./bin/toplevel.opt ./bin/ptests.opt $(WP_QUALIF_CACHE)
- @echo "[CACHE] pull cache"
- @echo "[CACHE] $(WP_QUALIF_CACHE)"
- git -C $(WP_QUALIF_CACHE) pull --rebase --prune
+ $(WP_PULL_CACHE)
@echo "[TESTS] updating wp-qualif"
FRAMAC_WP_CACHE=update \
FRAMAC_WP_CACHEDIR=$(WP_QUALIF_CACHE) \
@@ -191,9 +195,7 @@ wp-qualif-update: ./bin/toplevel.opt ./bin/ptests.opt $(WP_QUALIF_CACHE)
@echo "New entries: `$(WP_QUALIF_ENTRIES)`"
wp-qualif-upgrade: ./bin/toplevel.opt ./bin/ptests.opt
- @echo "[CACHE] pull cache"
- @echo "[CACHE] repo: $(WP_QUALIF_CACHE)"
- git -C $(WP_QUALIF_CACHE) pull --rebase --prune
+ $(WP_PULL_CACHE)
@echo "[TESTS] upgrading wp-qualif (cache & scripts)"
FRAMAC_WP_CACHE=update \
FRAMAC_WP_SCRIPT=update \
@@ -205,14 +207,14 @@ wp-qualif-upgrade: ./bin/toplevel.opt ./bin/ptests.opt
wp-qualif-push:
@echo "[CACHE] pushing updates"
- @echo "[CACHE] repo: $(WP_QUALIF_CACHE)"
+ $(WP_CHECKOUT_CACHE)
git -C $(WP_QUALIF_CACHE) add -A
git -C $(WP_QUALIF_CACHE) commit -m "[wp] cache updates"
git -C $(WP_QUALIF_CACHE) push -f
wp-qualif-status:
@echo "[CACHE] status"
- @echo "[CACHE] repo: $(WP_QUALIF_CACHE)"
+ $(WP_CHECKOUT_CACHE)
git -C $(WP_QUALIF_CACHE) status -s -b -u no
@echo "New entries: `$(WP_QUALIF_ENTRIES)`"
diff --git a/src/plugins/wp/ProverWhy3.ml b/src/plugins/wp/ProverWhy3.ml
index 07b0ef0257e942702a812436a6d212057a865a3b..2d9a6ce177b2444d77f578b6d09607cfc66524be 100644
--- a/src/plugins/wp/ProverWhy3.ml
+++ b/src/plugins/wp/ProverWhy3.ml
@@ -1198,7 +1198,7 @@ let ping_prover_call p =
VCS.pp_result r;
Task.Return (Task.Result r)
-let call_prover ~timeout ~steplimit drv prover prover_config task =
+let call_prover prover_config ~timeout ~steplimit drv prover task =
let steps = match steplimit with Some 0 -> None | _ -> steplimit in
let limit =
let def = Why3.Call_provers.empty_limit in
@@ -1230,217 +1230,6 @@ let call_prover ~timeout ~steplimit drv prover prover_config task =
in
Task.async ping
-(* -------------------------------------------------------------------------- *)
-(* --- Cache Management --- *)
-(* -------------------------------------------------------------------------- *)
-
-type mode = NoCache | Update | Replay | Rebuild | Offline | Cleanup
-
-let hits = ref 0
-let miss = ref 0
-let removed = ref 0
-let cleanup = Hashtbl.create 0
-(* used entries, never to be reset since cleanup is performed at exit *)
-
-let get_hits () = !hits
-let get_miss () = !miss
-let get_removed () = !removed
-
-let mark_cache ~mode hash =
- if mode = Cleanup || !Fc_config.is_gui then Hashtbl.replace cleanup hash ()
-
-module CACHEDIR = WpContext.StaticGenerator(Datatype.Unit)
- (struct
- type key = unit
- type data = Filepath.Normalized.t
- let name = "Wp.Cache.dir"
- let compile () =
- try
- if not (Wp_parameters.CacheEnv.get()) then
- raise Not_found ;
- let gdir = Sys.getenv "FRAMAC_WP_CACHEDIR" in
- if gdir = "" then raise Not_found ;
- Filepath.Normalized.of_string gdir
- with Not_found ->
- try
- let gdir = Wp_parameters.CacheDir.get() in
- if gdir = "" then raise Not_found ;
- Filepath.Normalized.of_string gdir
- with Not_found ->
- Wp_parameters.get_session_dir ~force:false "cache"
- end)
-
-let get_cache_dir () = (CACHEDIR.get () :> string)
-
-let has_cache_dir () =
- try
- if not (Wp_parameters.CacheEnv.get()) then
- raise Not_found ;
- Sys.getenv "FRAMAC_WP_CACHEDIR" <> ""
- with Not_found -> Wp_parameters.CacheDir.get () <> ""
-
-let is_global_cache () = Wp_parameters.CacheDir.get () <> ""
-
-let cleanup_cache ~mode =
- if mode = Cleanup && (!hits > 0 || !miss > 0) then
- let dir = get_cache_dir () in
- if is_global_cache () then
- Wp_parameters.warning ~current:false ~once:true
- "Cleanup mode deactivated with global cache."
- else
- try
- if Sys.file_exists dir && Sys.is_directory dir then
- Array.iter
- (fun f ->
- if Filename.check_suffix f ".json" then
- let hash = Filename.chop_suffix f ".json" in
- if not (Hashtbl.mem cleanup hash) then
- begin
- incr removed ;
- Extlib.safe_remove (Printf.sprintf "%s/%s" dir f) ;
- end
- ) (Sys.readdir dir) ;
- with Unix.Unix_error _ as exn ->
- Wp_parameters.warning ~current:false
- "Can not cleanup cache (%s)" (Printexc.to_string exn)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Cache Management --- *)
-(* -------------------------------------------------------------------------- *)
-
-let parse_mode ~origin ~fallback = function
- | "none" -> NoCache
- | "update" -> Update
- | "replay" -> Replay
- | "rebuild" -> Rebuild
- | "offline" -> Offline
- | "cleanup" -> Cleanup
- | "" -> raise Not_found
- | m ->
- Wp_parameters.warning ~current:false
- "Unknown %s mode %S (use %s instead)" origin m fallback ;
- raise Not_found
-
-let mode_name = function
- | NoCache -> "none"
- | Update -> "update"
- | Replay -> "replay"
- | Rebuild -> "rebuild"
- | Offline -> "offline"
- | Cleanup -> "cleanup"
-
-module MODE = WpContext.StaticGenerator(Datatype.Unit)
- (struct
- type key = unit
- type data = mode
- let name = "Wp.Cache.mode"
- let compile () =
- try
- if not (Wp_parameters.CacheEnv.get()) then
- raise Not_found ;
- let origin = "FRAMAC_WP_CACHE" in
- parse_mode ~origin ~fallback:"-wp-cache" (Sys.getenv origin)
- with Not_found ->
- try
- let mode = Wp_parameters.Cache.get() in
- parse_mode ~origin:"-wp-cache" ~fallback:"none" mode
- with Not_found ->
- if Wp_parameters.has_session () || has_cache_dir ()
- then Update else NoCache
- end)
-
-let get_mode = MODE.get
-let set_mode m = MODE.clear () ; Wp_parameters.Cache.set (mode_name m)
-
-let task_hash wpo drv prover task =
- lazy
- begin
- let file = Wpo.DISK.file_goal
- ~pid:wpo.Wpo.po_pid
- ~model:wpo.Wpo.po_model
- ~prover:(VCS.Why3 prover) in
- let _ = Command.print_file file
- begin fun fmt ->
- Format.fprintf fmt "(* WP Task for Prover %s *)@\n"
- (Why3Provers.print_why3 prover) ;
- Why3.Driver.print_task_prepared drv fmt task ;
- end
- in Digest.file file |> Digest.to_hex
- end
-
-let time_fits time = function
- | None | Some 0 -> true
- | Some limit -> time <= float limit
-
-let steps_fits steps = function
- | None | Some 0 -> true
- | Some limit -> steps <= limit
-
-let time_seized time = function
- | None | Some 0 -> false
- | Some limit -> float limit <= time
-
-let steps_seized steps steplimit =
- steps <> 0 &&
- match steplimit with
- | None | Some 0 -> false
- | Some limit -> limit <= steps
-
-let promote ~timeout ~steplimit (res : VCS.result) =
- match res.verdict with
- | VCS.NoResult | VCS.Computing _ -> VCS.no_result
- | VCS.Failed -> res
- | VCS.Invalid | VCS.Valid | VCS.Unknown ->
- if not (steps_fits res.prover_steps steplimit) then
- { res with verdict = Stepout }
- else
- if not (time_fits res.prover_time timeout) then
- { res with verdict = Timeout }
- else res
- | VCS.Timeout | VCS.Stepout ->
- if steps_seized res.prover_steps steplimit then
- { res with verdict = Stepout }
- else
- if time_seized res.prover_time timeout then
- { res with verdict = Timeout }
- else (* can be run a longer time or widely *)
- VCS.no_result
-
-let get_cache_result ~mode hash =
- match mode with
- | NoCache | Rebuild -> VCS.no_result
- | Update | Cleanup | Replay | Offline ->
- let dir = get_cache_dir () in
- if not (Sys.file_exists dir && Sys.is_directory dir) then
- VCS.no_result
- else
- let hash = Lazy.force hash in
- let file = Printf.sprintf "%s/%s.json" dir hash in
- if not (Sys.file_exists file) then VCS.no_result
- else
- try
- mark_cache ~mode hash ;
- Json.load_file file |> ProofScript.result_of_json
- with err ->
- Wp_parameters.warning ~current:false ~once:true
- "invalid cache entry (%s)" (Printexc.to_string err) ;
- VCS.no_result
-
-let set_cache_result ~mode hash prover result =
- match mode with
- | NoCache | Replay | Offline -> ()
- | Rebuild | Update | Cleanup ->
- let dir = CACHEDIR.get () in
- let hash = Lazy.force hash in
- let file = Printf.sprintf "%s/%s.json" (dir :> string) hash in
- try
- mark_cache ~mode hash ;
- ProofScript.json_of_result (VCS.Why3 prover) result
- |> Json.save_file file
- with err ->
- Wp_parameters.warning ~current:false ~once:true
- "can not update cache (%s)" (Printexc.to_string err)
-
let is_trivial (t : Why3.Task.task) =
let goal = Why3.Task.task_goal_fmla t in
Why3.Term.t_equal goal Why3.Term.t_true
@@ -1462,35 +1251,8 @@ let build_proof_task ?timeout ?steplimit ~prover wpo () =
if is_trivial task then
Task.return VCS.valid
else
- let mode = get_mode () in
- match mode with
- | NoCache ->
- call_prover ~timeout ~steplimit drv prover config task
- | Offline ->
- let hash = task_hash wpo drv prover task in
- let result = get_cache_result ~mode hash |> VCS.cached in
- if VCS.is_verdict result then incr hits else incr miss ;
- Task.return result
- | Update | Replay | Rebuild | Cleanup ->
- let hash = task_hash wpo drv prover task in
- let result =
- get_cache_result ~mode hash
- |> promote ~timeout ~steplimit |> VCS.cached in
- if VCS.is_verdict result
- then
- begin
- incr hits ;
- Task.return result
- end
- else
- Task.finally
- (call_prover ~timeout ~steplimit drv prover config task)
- begin function
- | Task.Result result when VCS.is_verdict result ->
- incr miss ;
- set_cache_result ~mode hash prover result
- | _ -> ()
- end
+ Cache.get_result wpo (call_prover config)
+ ~timeout ~steplimit drv prover task
with exn ->
if Wp_parameters.has_dkey dkey_api then
Wp_parameters.fatal "[Why3 Error] %a@\n%s"
diff --git a/src/plugins/wp/ProverWhy3.mli b/src/plugins/wp/ProverWhy3.mli
index 487eb531c73b2bb1c3906af61d60dcc330ac7a93..ea029e0804bc7aba4a8f25d66b18a043dd0804ea 100644
--- a/src/plugins/wp/ProverWhy3.mli
+++ b/src/plugins/wp/ProverWhy3.mli
@@ -30,14 +30,4 @@ val prove : ?timeout:int -> ?steplimit:int -> prover:Why3Provers.t ->
Wpo.t -> VCS.result Task.task
(** Return NoResult if it is already proved by Qed *)
-type mode = NoCache | Update | Replay | Rebuild | Offline | Cleanup
-
-val set_mode : mode -> unit
-val get_mode : unit -> mode
-val get_hits : unit -> int
-val get_miss : unit -> int
-val get_removed : unit -> int
-
-val cleanup_cache : mode:mode -> unit
-
(**************************************************************************)
diff --git a/src/plugins/wp/VCS.ml b/src/plugins/wp/VCS.ml
index 5d8d33d6c3742de548535a7581d8a835674097b1..c92b0ca59fb985c1a5b76353ce52de64594e1ba7 100644
--- a/src/plugins/wp/VCS.ml
+++ b/src/plugins/wp/VCS.ml
@@ -24,11 +24,7 @@
(* --- Prover Results --- *)
(* -------------------------------------------------------------------------- *)
-let dkey_no_time_info = Wp_parameters.register_category "no-time-info"
-let dkey_no_step_info = Wp_parameters.register_category "no-step-info"
-let dkey_no_goals_info = Wp_parameters.register_category "no-goals-info"
-let dkey_no_cache_info = Wp_parameters.register_category "no-cache-info"
-let dkey_success_only = Wp_parameters.register_category "success-only"
+let dkey_shell = Wp_parameters.register_category "shell"
type prover =
| Why3 of Why3Provers.t (* Prover via WHY *)
@@ -91,7 +87,7 @@ let name_of_prover = function
let title_of_prover = function
| Why3 s ->
- if Wp_parameters.has_dkey dkey_success_only
+ if Wp_parameters.has_dkey dkey_shell
then Why3Provers.name s
else Why3Provers.title s
| NativeAltErgo -> "Alt-Ergo (native)"
@@ -298,15 +294,15 @@ let perfo dkey = not (Wp_parameters.has_dkey dkey)
let pp_perf fmt r =
begin
let t = r.solver_time in
- if t > Rformat.epsilon && perfo dkey_no_time_info
+ if t > Rformat.epsilon && perfo dkey_shell
then Format.fprintf fmt " (Qed:%a)" Rformat.pp_time t ;
let t = r.prover_time in
- if t > Rformat.epsilon && perfo dkey_no_time_info
+ if t > Rformat.epsilon && perfo dkey_shell
then Format.fprintf fmt " (%a)" Rformat.pp_time t ;
let s = r.prover_steps in
- if s > 0 && perfo dkey_no_step_info
+ if s > 0 && perfo dkey_shell
then Format.fprintf fmt " (%d)" s ;
- if r.cached && perfo dkey_no_cache_info
+ if r.cached && perfo dkey_shell
then Format.fprintf fmt " (cached)" ;
end
@@ -328,13 +324,13 @@ let pp_cache_miss fmt st prover r =
| NativeAltErgo | NativeCoq -> r.verdict <> Timeout
| Why3 _ -> r.cached || r.prover_time < Rformat.epsilon
in
- if qualified then
- Format.pp_print_string fmt (if is_valid r then "Valid" else "Unsuccess")
- else
+ if not qualified && Wp_parameters.has_dkey dkey_shell then
Format.fprintf fmt "%s%a (unqualified)" st pp_perf r
+ else
+ Format.pp_print_string fmt (if is_valid r then "Valid" else "Unsuccess")
let pp_result_qualif prover fmt r =
- if Wp_parameters.has_dkey dkey_success_only then
+ if Wp_parameters.has_dkey dkey_shell then
match r.verdict with
| NoResult -> Format.pp_print_string fmt "No Result"
| Computing _ -> Format.pp_print_string fmt "Computing"
diff --git a/src/plugins/wp/VCS.mli b/src/plugins/wp/VCS.mli
index 87b2a3fb7a726999ee54f33b9bc10d7e53f70c1f..0e869ebea1458ef899c8e8ea6ff4b563cf224644 100644
--- a/src/plugins/wp/VCS.mli
+++ b/src/plugins/wp/VCS.mli
@@ -126,8 +126,4 @@ val merge : result -> result -> result
val choose : result -> result -> result
val best : result list -> result
-val dkey_no_time_info: Wp_parameters.category
-val dkey_no_step_info: Wp_parameters.category
-val dkey_no_goals_info: Wp_parameters.category
-val dkey_no_cache_info: Wp_parameters.category
-val dkey_success_only: Wp_parameters.category
+val dkey_shell: Wp_parameters.category
diff --git a/src/plugins/wp/doc/manual/wp_plugin.tex b/src/plugins/wp/doc/manual/wp_plugin.tex
index c8b8b89130d3bc301d2b89a9aa88880de8598c85..650b869af3ec4b4989e7e1e3333dc3833c965ceb 100644
--- a/src/plugins/wp/doc/manual/wp_plugin.tex
+++ b/src/plugins/wp/doc/manual/wp_plugin.tex
@@ -1290,12 +1290,17 @@ There are different ways of using the cache, depending on your precise needs.
The main option to control cache usage is \verb+-wp-cache+, documented below:
\begin{description}
-\item[\tt -wp-session <dir>] select the directory where cached results and proof scripts
- are stored. If the local directory \verb+'.frama-c'+ already exists, the default session
- directory \verb+'.frama-c/wp'+ will be used to setup the \textsf{WP} session.
-\item[\tt -wp-cache <mode>] selects the cache mode to use with \textsf{Why-3} provers. The default mode is \verb'update'
- if a \textsf{WP} session is set, and \verb+none+ otherwise. The cache entries are stored in the session directory,
- which is \verb+./.frama-c/wp/cache+ by default.
+\item[\tt -wp-cache <mode>] selects the cache mode to use with \textsf{Why-3}
+ provers. The default mode is \verb'update' if there is \textsf{WP} session
+ available, and \verb+none+ otherwise. You can also use the environment
+ variable \texttt{FRAMAC\_WP\_CACHE} instead.
+\item[\tt -wp-cache-dir <dir>] select the directory where cached results are
+ stored. By default, the cache is store in the \textsf{WP} session
+ directory, when available.
+ You can also use the environment variable
+ \texttt{FRAMAC\_WP\_CACHEDIR} instead.
+\item[\tt -wp-cache-env] gives environment variables the precedence over command line options.
+ By default, the command line options take precedence, as usual.
\end{description}
The available cache modes are described below:
@@ -1309,7 +1314,6 @@ The available cache modes are described below:
\end{description}
When using cache with a non-\verb+offline+ mode, time and steps limits recorded in the cache are compared to the command line settings to produce meaningful and consistent results. Hence, if you provide more time or more steps from the command line than before, the prover would be run again. If you provide less or equal limits, the cache entries are reused, but \textsf{WP} still report the cached time and step limits to inform you of your previous attempts. For instance, if you have in the cache a « Valid » entry with time 12.4s and re-run it with a timeout of 5s, you will have a « Timeout » result with time 12.4s printed on the console.
-Cached usage is indicated on the standard output, unless you specify \verb+-wp-msg-key no-cache-info+.
\section{Plug-in Developer Interface}
\label{wp-api}
diff --git a/src/plugins/wp/register.ml b/src/plugins/wp/register.ml
index ccba10093be6cb8ecd8219de1164529489d2545c..c350f0f5779d5de2272bee29683161bf140e4290 100644
--- a/src/plugins/wp/register.ml
+++ b/src/plugins/wp/register.ml
@@ -24,7 +24,6 @@ open Factory
let dkey_main = Wp_parameters.register_category "main"
let dkey_raised = Wp_parameters.register_category "raised"
-let dkey_shell = Wp_parameters.register_category "shell"
let wkey_smoke = Wp_parameters.register_warn_category "smoke"
(* --------- Command Line ------------------- *)
@@ -264,20 +263,17 @@ let add_time s t =
end
let do_list_scheduled iter_on_goals =
- if not (Wp_parameters.has_dkey VCS.dkey_no_goals_info) then
- begin
- clear_scheduled () ;
- iter_on_goals
- (fun goal ->
- begin
- incr scheduled ;
- if !spy then session := GOALS.add goal !session ;
- end) ;
- match !scheduled with
- | 0 -> Wp_parameters.warning ~current:false "No goal generated"
- | 1 -> Wp_parameters.feedback "1 goal scheduled"
- | n -> Wp_parameters.feedback "%d goals scheduled" n
- end
+ clear_scheduled () ;
+ iter_on_goals
+ (fun goal ->
+ begin
+ incr scheduled ;
+ if !spy then session := GOALS.add goal !session ;
+ end) ;
+ match !scheduled with
+ | 0 -> Wp_parameters.warning ~current:false "No goal generated"
+ | 1 -> Wp_parameters.feedback "1 goal scheduled"
+ | n -> Wp_parameters.feedback "%d goals scheduled" n
let dkey_prover = Wp_parameters.register_category "prover"
@@ -306,11 +302,10 @@ let do_progress goal msg =
let do_report_cache_usage mode =
if !exercised > 0 &&
- not (Wp_parameters.has_dkey dkey_shell) &&
- not (Wp_parameters.has_dkey VCS.dkey_no_cache_info)
+ not (Wp_parameters.has_dkey VCS.dkey_shell)
then
- let hits = ProverWhy3.get_hits () in
- let miss = ProverWhy3.get_miss () in
+ let hits = Cache.get_hits () in
+ let miss = Cache.get_miss () in
if hits <= 0 && miss <= 0 then
Wp_parameters.result "[Cache] not used"
else
@@ -321,20 +316,20 @@ let do_report_cache_usage mode =
if n > 0 then
( Format.fprintf fmt "%s%s:%d" !sep job n ; sep := ", " ) in
match mode with
- | ProverWhy3.NoCache -> ()
- | ProverWhy3.Replay ->
+ | Cache.NoCache -> ()
+ | Cache.Replay ->
pp_cache fmt hits "found" ;
pp_cache fmt miss "missed" ;
Format.pp_print_newline fmt () ;
- | ProverWhy3.Offline ->
+ | Cache.Offline ->
pp_cache fmt hits "found" ;
pp_cache fmt miss "failed" ;
Format.pp_print_newline fmt () ;
- | ProverWhy3.Update | ProverWhy3.Cleanup ->
+ | Cache.Update | Cache.Cleanup ->
pp_cache fmt hits "found" ;
pp_cache fmt miss "updated" ;
Format.pp_print_newline fmt () ;
- | ProverWhy3.Rebuild ->
+ | Cache.Rebuild ->
pp_cache fmt hits "replaced" ;
pp_cache fmt miss "updated" ;
Format.pp_print_newline fmt () ;
@@ -451,8 +446,7 @@ let do_report_time fmt s =
begin
if s.n_time > 0 &&
s.u_time > Rformat.epsilon &&
- not (Wp_parameters.has_dkey VCS.dkey_no_time_info) &&
- not (Wp_parameters.has_dkey VCS.dkey_success_only)
+ not (Wp_parameters.has_dkey VCS.dkey_shell)
then
let mean = s.a_time /. float s.n_time in
let epsilon = 0.05 *. mean in
@@ -475,14 +469,13 @@ let do_report_time fmt s =
let do_report_steps fmt s =
begin
if s.steps > 0 &&
- not (Wp_parameters.has_dkey VCS.dkey_no_step_info) &&
- not (Wp_parameters.has_dkey VCS.dkey_success_only)
+ not (Wp_parameters.has_dkey VCS.dkey_shell)
then
Format.fprintf fmt " (%d)" s.steps ;
end
let do_report_stopped fmt s =
- if Wp_parameters.has_dkey VCS.dkey_success_only then
+ if Wp_parameters.has_dkey VCS.dkey_shell then
begin
let n = s.interrupted + s.unknown in
if n > 0 then
@@ -511,27 +504,26 @@ let do_report_prover_stats pp_prover fmt (p,s) =
end
let do_report_scheduled () =
- if not (Wp_parameters.has_dkey VCS.dkey_no_goals_info) then
- if Wp_parameters.Generate.get () then
- let plural = if !exercised > 1 then "s" else "" in
- Wp_parameters.result "%d goal%s generated" !exercised plural
- else
- if !scheduled > 0 then
- begin
- let proved = GOALS.cardinal !proved in
- let mode = ProverWhy3.get_mode () in
- if mode <> ProverWhy3.NoCache then do_report_cache_usage mode ;
- Wp_parameters.result "%t"
- begin fun fmt ->
- Format.fprintf fmt "Proved goals: %4d / %d@\n" proved !scheduled ;
- Pretty_utils.pp_items
- ~min:12 ~align:`Left
- ~title:(fun (prover,_) -> VCS.title_of_prover prover)
- ~iter:(fun f -> PM.iter (fun p s -> f (p,s)) !provers)
- ~pp_title:(fun fmt a -> Format.fprintf fmt "%s:" a)
- ~pp_item:do_report_prover_stats fmt ;
- end ;
- end
+ if Wp_parameters.Generate.get () then
+ let plural = if !exercised > 1 then "s" else "" in
+ Wp_parameters.result "%d goal%s generated" !exercised plural
+ else
+ if !scheduled > 0 then
+ begin
+ let proved = GOALS.cardinal !proved in
+ let mode = Cache.get_mode () in
+ if mode <> Cache.NoCache then do_report_cache_usage mode ;
+ Wp_parameters.result "%t"
+ begin fun fmt ->
+ Format.fprintf fmt "Proved goals: %4d / %d@\n" proved !scheduled ;
+ Pretty_utils.pp_items
+ ~min:12 ~align:`Left
+ ~title:(fun (prover,_) -> VCS.title_of_prover prover)
+ ~iter:(fun f -> PM.iter (fun p s -> f (p,s)) !provers)
+ ~pp_title:(fun fmt a -> Format.fprintf fmt "%s:" a)
+ ~pp_item:do_report_prover_stats fmt ;
+ end ;
+ end
let do_list_scheduled_result () =
begin
@@ -736,12 +728,10 @@ let do_wp_proofs_for goals = do_wp_proofs_iter (fun f -> Bag.iter f goals)
(* registered at frama-c (normal) exit *)
let do_cache_cleanup () =
begin
- let mode = ProverWhy3.get_mode () in
- ProverWhy3.cleanup_cache ~mode ;
- let removed = ProverWhy3.get_removed () in
+ Cache.cleanup_cache () ;
+ let removed = Cache.get_removed () in
if removed > 0 &&
- not (Wp_parameters.has_dkey dkey_shell) &&
- not (Wp_parameters.has_dkey VCS.dkey_no_cache_info)
+ not (Wp_parameters.has_dkey VCS.dkey_shell)
then
Wp_parameters.result "[Cache] removed:%d" removed
end
@@ -812,6 +802,8 @@ let cmdline_run () =
end ;
Generator.compute_selection computer ~fct ~bhv ~prop ()
in
+ if Wp_parameters.CachePrint.get () then
+ Kernel.feedback "Cache directory: %s" (Cache.get_dir ()) ;
let fct = Wp_parameters.get_wp () in
match fct with
| Wp_parameters.Fct_none -> ()
@@ -905,7 +897,10 @@ let pp_wp_parameters fmt =
if Wp_parameters.RTE.get () then Format.pp_print_string fmt " -wp-rte" ;
let spec = Wp_parameters.Model.get () in
if spec <> [] && spec <> ["Typed"] then
- ( let descr = Factory.descr (Factory.parse spec) in
+ ( let descr =
+ if spec = ["Dump"] then "Dump"
+ else Factory.descr (Factory.parse spec)
+ in
Format.fprintf fmt " -wp-model '%s'" descr ) ;
if not (Wp_parameters.Let.get ()) then Format.pp_print_string fmt
" -wp-no-let" ;
@@ -932,7 +927,7 @@ let pp_wp_parameters fmt =
let () = Cmdline.run_after_setting_files
(fun _ ->
- if Wp_parameters.has_dkey dkey_shell then
+ if Wp_parameters.has_dkey VCS.dkey_shell then
Log.print_on_output pp_wp_parameters)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/tests/README.md b/src/plugins/wp/tests/README.md
index 22304d9713e6856ad19c3ba07aa90da92aa43df5..68134928bbc16a587fa10b91746e0fbadd61da20 100644
--- a/src/plugins/wp/tests/README.md
+++ b/src/plugins/wp/tests/README.md
@@ -59,11 +59,16 @@ doing so would causing WP to add new cache entries to the global « qualif » ca
from all your projects around. Consult the section « Global WP Cache Setup »
below for details.
+Note that this cache is meant to be global, including for the different merge
+requests. Thus, when working on a new merge request for WP, **do not** create a
+branch (and MR) on the WP-cache repository: just push the new cache entries into
+the global cache using `make wp-qualif-push`.
+
# Qualified Test Results
To be accepted by Frama-CI, tests in « qualif » configuration must be easily
reproducible on any platform. This is checked by running WP with flag
-`-wp-msg-key success-only` which is set by the default in the qualif test
+`-wp-msg-key shell` which is set by the default in the qualif test
configuration. Hence, a qualified test result only contains proof status that
are either:
- failed
@@ -75,7 +80,7 @@ are either:
This excludes any timeout with native Alt-Ergo, which must be turned into some
reproducible stepout by setting `-wp-steps` and `-wp-timeout` options
accordingly. Please choose a step limit that makes large enough to ensure the
-goal is not provable, but small enough to make alt-ergo decide quickly.
+goal is provable, but small enough to make alt-ergo decide quickly.
# Global WP Cache Setup (for wp-qualif)
@@ -105,11 +110,10 @@ environment. To run individual tests, you may now use:
$ export FRAMAC_WP_CACHEDIR=$WP_QUALIF_CACHE
$ ./bin/ptests.opt src/plugins/wp/tests/xxx/yyy.i -config qualif [-show|-update]
-The necessary environment variables can also be displayed by the makefile:
+An utility script is provided to export the necessary environment variables
+(dont forget the `.` to execute the script in the current shell environment):
- $ make wp-qualif-env
- FRAMAC_WP_CACHE=update
- FRAMAC_WP_CACHEDIR=$WP_QUALIF_CACHE
+ $ . bin/wp_qualif.sh
As mentionned above, it is _not_ recommanded to globally set the
`FRAMAC_WP_XXX` variables in your default shell environment, because WP will
diff --git a/src/plugins/wp/tests/test_config_qualif b/src/plugins/wp/tests/test_config_qualif
index 2fb225cf969783f35136d70c84351eb7ff294699..82ac23797226aae576338c46106f95e16f40b717 100644
--- a/src/plugins/wp/tests/test_config_qualif
+++ b/src/plugins/wp/tests/test_config_qualif
@@ -1,2 +1,2 @@
-CMD: @frama-c@ -no-autoload-plugins -load-module wp -wp -wp-par 1 -wp-share ./share -wp-msg-key shell,success-only -wp-report tests/qualif.report -wp-session @PTEST_DIR@/oracle@PTEST_CONFIG@/@PTEST_NAME@.@PTEST_NUMBER@.session -wp-cache replay @PTEST_FILE@ -wp-coq-timeout 120
+CMD: @frama-c@ -no-autoload-plugins -load-module wp -wp -wp-par 1 -wp-share ./share -wp-msg-key shell -wp-report tests/qualif.report -wp-session @PTEST_DIR@/oracle@PTEST_CONFIG@/@PTEST_NAME@.@PTEST_NUMBER@.session -wp-cache-env -wp-cache replay @PTEST_FILE@ -wp-coq-timeout 120
OPT:
diff --git a/src/plugins/wp/tests/wp/stmtcompiler_test.i b/src/plugins/wp/tests/wp/stmtcompiler_test.i
index 264b9e58d48e6401b1c73564a7755720598f2b97..c610d54549272ce23c3610a5e58846880fcd5b00 100644
--- a/src/plugins/wp/tests/wp/stmtcompiler_test.i
+++ b/src/plugins/wp/tests/wp/stmtcompiler_test.i
@@ -1,5 +1,5 @@
/* run.config
- OPT: -load-script tests/wp/stmtcompiler_test.ml -wp-msg-key success-only
+ OPT: -load-script tests/wp/stmtcompiler_test.ml -wp-msg-key shell
*/
int empty (int c){
diff --git a/src/plugins/wp/tests/wp/stmtcompiler_test_rela.i b/src/plugins/wp/tests/wp/stmtcompiler_test_rela.i
index 4dafe25db11100c8549fc7f6291914f0a31f9df0..b206efad0519db1f347ae4a6b79e5221ff611f9d 100644
--- a/src/plugins/wp/tests/wp/stmtcompiler_test_rela.i
+++ b/src/plugins/wp/tests/wp/stmtcompiler_test_rela.i
@@ -1,5 +1,5 @@
/* run.config_qualif
- OPT: -load-script tests/wp/stmtcompiler_test_rela.ml -wp-msg-key success-only
+ OPT: -load-script tests/wp/stmtcompiler_test_rela.ml -wp-msg-key shell
*/
int empty (int c){
diff --git a/src/plugins/wp/tests/wp/wp_strategy.c b/src/plugins/wp/tests/wp/wp_strategy.c
index 0afd35c132005b5dc32d047c4d9847b410013b91..c514347a72a233922e656c26095d63647feea376 100644
--- a/src/plugins/wp/tests/wp/wp_strategy.c
+++ b/src/plugins/wp/tests/wp/wp_strategy.c
@@ -4,7 +4,7 @@ OPT: -journal-disable -wp-model Typed -wp-verbose 2 -wp-prop @assigns
*/
/* run.config_qualif
-OPT: -journal-disable -rte -wp -wp-model Hoare -wp-par 1 -wp-msg-key "success-only"
+OPT: -journal-disable -rte -wp -wp-model Hoare -wp-par 1 -wp-msg-key shell
*/
/*----------------------------------------------------------------------------*/
@@ -89,7 +89,7 @@ int default_behaviors (int c, int x) {
int y;
//@ ensures qed_ok: stmt_p: x > 0; assigns qed_ok: x;
- if (c) x = 1;
+ if (c) x = 1;
else {
//@ assert qed_ok: x >= 0;
x++;
diff --git a/src/plugins/wp/tests/wp_acsl/boolean.i b/src/plugins/wp/tests/wp_acsl/boolean.i
index f8e7f458b4f55d82f878bfed3a4a83f71dd3352e..79f94c24a8a358a23922d03fee6157f4d6f03ad1 100644
--- a/src/plugins/wp/tests/wp_acsl/boolean.i
+++ b/src/plugins/wp/tests/wp_acsl/boolean.i
@@ -1,5 +1,5 @@
/* run.config
-OPT: -wp-gen -wp-prover why3 -wp-msg-key success-only
+OPT: -wp-gen -wp-prover why3 -wp-msg-key shell
*/
/*@
diff --git a/src/plugins/wp/tests/wp_acsl/oracle_qualif/cnf.res.oracle b/src/plugins/wp/tests/wp_acsl/oracle_qualif/cnf.res.oracle
index 40c0c6de692e62b8846b7a62e3bc02b1dcfb564c..979b8b88f24de686b3269c1c829b0bf3c69cf033 100644
--- a/src/plugins/wp/tests/wp_acsl/oracle_qualif/cnf.res.oracle
+++ b/src/plugins/wp/tests/wp_acsl/oracle_qualif/cnf.res.oracle
@@ -305,4 +305,4 @@
Functions WP Alt-Ergo Total Success
f 12 31 43 100%
------------------------------------------------------------
-[wp] Logging keys: success-only,shell,cnf.
+[wp] Logging keys: shell,cnf.
diff --git a/src/plugins/wp/tests/wp_bts/issue_898.i b/src/plugins/wp/tests/wp_bts/issue_898.i
new file mode 100644
index 0000000000000000000000000000000000000000..76c3fa6d43e8ccb9c7aa6fb68859a691ad83ea51
--- /dev/null
+++ b/src/plugins/wp/tests/wp_bts/issue_898.i
@@ -0,0 +1,14 @@
+struct S {
+ int valid;
+ double value;
+};
+
+/*@
+ requires \is_finite(val);
+ ensures \eq_double(\result.value,val);
+ assigns \nothing;
+*/
+struct S job(double val) {
+ struct S result = { 0, val };
+ return result;
+}
diff --git a/src/plugins/wp/tests/wp_bts/oracle/issue_898.res.oracle b/src/plugins/wp/tests/wp_bts/oracle/issue_898.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..f3dbc6f8d161250a1dab323a3012745b1929ae9c
--- /dev/null
+++ b/src/plugins/wp/tests/wp_bts/oracle/issue_898.res.oracle
@@ -0,0 +1,20 @@
+# frama-c -wp [...]
+[kernel] Parsing tests/wp_bts/issue_898.i (no preprocessing)
+[wp] Running WP plugin...
+[wp] Loading driver 'share/wp.driver'
+[wp] Warning: Missing RTE guards
+------------------------------------------------------------
+ Function job
+------------------------------------------------------------
+
+Goal Post-condition (file tests/wp_bts/issue_898.i, line 8) in 'job':
+Let a = job_0.F1_S_value.
+Assume { (* Pre-condition *) Have: is_finite_f64(a). }
+Prove: eq_f64(a, a).
+
+------------------------------------------------------------
+
+Goal Assigns nothing in 'job':
+Prove: true.
+
+------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_bts/oracle_qualif/issue_898.res.oracle b/src/plugins/wp/tests/wp_bts/oracle_qualif/issue_898.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..7d9049804fb645d575944e4ce403903b3c3e6b8c
--- /dev/null
+++ b/src/plugins/wp/tests/wp_bts/oracle_qualif/issue_898.res.oracle
@@ -0,0 +1,15 @@
+# frama-c -wp [...]
+[kernel] Parsing tests/wp_bts/issue_898.i (no preprocessing)
+[wp] Running WP plugin...
+[wp] Loading driver 'share/wp.driver'
+[wp] Warning: Missing RTE guards
+[wp] 2 goals scheduled
+[wp] [Alt-Ergo] Goal typed_job_ensures : Valid
+[wp] [Qed] Goal typed_job_assigns : Valid
+[wp] Proved goals: 2 / 2
+ Qed: 1
+ Alt-Ergo: 1
+------------------------------------------------------------
+ Functions WP Alt-Ergo Total Success
+ job 1 1 2 100%
+------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_gallery/oracle/frama_c_hashtbl_solved.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle/frama_c_hashtbl_solved.res.oracle
index 00a8df49e163c00104c97b7203e10f9e6f4accfa..064dce264b9e7e20ae5c3d9799927e9b346ed87c 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle/frama_c_hashtbl_solved.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle/frama_c_hashtbl_solved.res.oracle
@@ -8,7 +8,6 @@
[rte] annotating function init
[rte] annotating function mem_binding
[rte] annotating function size
-[wp] Computing [100 goals...]
[wp] Goal typed_add_complete_full_nominal : not tried
[wp] Goal typed_add_disjoint_full_nominal : not tried
[wp] Goal typed_add_assert_rte_index_bound : not tried
diff --git a/src/plugins/wp/tests/wp_gallery/oracle_qualif/frama_c_hashtbl_solved.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle_qualif/frama_c_hashtbl_solved.res.oracle
index 6e3fc54c35c0210277228789814f49736f648f08..8e5320587c9157e2971dc28f9078d3d860dbfd28 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle_qualif/frama_c_hashtbl_solved.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle_qualif/frama_c_hashtbl_solved.res.oracle
@@ -3,7 +3,6 @@
[wp] Running WP plugin...
[wp] Loading driver 'share/wp.driver'
[wp] Warning: Missing RTE guards
-[wp] Computing [100 goals...]
[wp] 102 goals scheduled
[wp] [Alt-Ergo] Goal typed_add_complete_full_nominal : Valid
[wp] [Alt-Ergo] Goal typed_add_disjoint_full_nominal : Valid
diff --git a/src/plugins/wp/tests/wp_manual/manual.i b/src/plugins/wp/tests/wp_manual/manual.i
index 7cd72107d4ca6d53372e573288e68d42ab88786c..11a04e0783ab7854b9dcb873766eaa739de19bfa 100644
--- a/src/plugins/wp/tests/wp_manual/manual.i
+++ b/src/plugins/wp/tests/wp_manual/manual.i
@@ -2,8 +2,8 @@
DONTRUN:
*/
/* run.config_qualif
- OPT: -wp-msg-key no-time-info @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap1.h
- OPT: -wp-msg-key no-time-info -wp-rte @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap2.h
- OPT: -load-module report -kernel-verbose 0 -wp-msg-key no-time-info -wp-rte @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap2.h -wp-verbose 0 -then -no-unicode -report
+ OPT: -wp-msg-key shell @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap1.h
+ OPT: -wp-msg-key shell -wp-rte @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap2.h
+ OPT: -load-module report -kernel-verbose 0 -wp-msg-key shell -wp-rte @PTEST_DIR@/working_dir/swap.c @PTEST_DIR@/working_dir/swap2.h -wp-verbose 0 -then -no-unicode -report
*/
void look_at_working_dir(void);
diff --git a/src/plugins/wp/tests/wp_plugin/oracle_qualif/removed.res.oracle b/src/plugins/wp/tests/wp_plugin/oracle_qualif/removed.res.oracle
index 98b421111a0747310342b30ae27213ef61a1adc8..b622a45a0f7a2daa0c28f30d33096e4fde0e5d6c 100644
--- a/src/plugins/wp/tests/wp_plugin/oracle_qualif/removed.res.oracle
+++ b/src/plugins/wp/tests/wp_plugin/oracle_qualif/removed.res.oracle
@@ -1,10 +1,11 @@
+# frama-c -wp [...]
[kernel] Parsing tests/wp_plugin/removed.i (no preprocessing)
[eva] Analyzing a complete application starting at main
[eva] Computing initial state
[eva] Initial state computed
[eva:initial-state] Values of globals at initialization
-[eva:alarm] tests/wp_plugin/removed.i:10: Warning:
+[eva:alarm] tests/wp_plugin/removed.i:9: Warning:
signed overflow. assert 1 + i ≤ 2147483647;
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
@@ -17,5 +18,10 @@
[wp] [Alt-Ergo] Goal typed_main_assert_Eva_signed_overflow : Unsuccess
[wp] Proved goals: 0 / 1
Alt-Ergo: 0 (unsuccess: 1)
+------------------------------------------------------------
+ Functions WP Alt-Ergo Total Success
+ main - - 1 0.0%
+------------------------------------------------------------
[wp] Running WP plugin...
[wp] Warning: No goal generated
+------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_plugin/oracle_qualif/stmt.log b/src/plugins/wp/tests/wp_plugin/oracle_qualif/stmt.log
index efc57b6183b5975f7b8605af6ecacb8409e2fa88..583f4d36f0886bdb9e400a01be8bc0d7723ec389 100644
--- a/src/plugins/wp/tests/wp_plugin/oracle_qualif/stmt.log
+++ b/src/plugins/wp/tests/wp_plugin/oracle_qualif/stmt.log
@@ -1,3 +1,4 @@
+# frama-c -wp -wp-model 'Dump' [...]
[kernel] Parsing tests/wp_plugin/stmt.c (with preprocessing)
[wp] Running WP plugin...
[wp] [CFG] Goal f_exits : Valid (Unreachable)
diff --git a/src/plugins/wp/tests/wp_plugin/removed.i b/src/plugins/wp/tests/wp_plugin/removed.i
index f27fb0df1d6386f8b02e3954f7cf1cab1d922897..9a4824f460e97fc22bacd03aae895c0e4c6147eb 100644
--- a/src/plugins/wp/tests/wp_plugin/removed.i
+++ b/src/plugins/wp/tests/wp_plugin/removed.i
@@ -1,6 +1,5 @@
/* run.config_qualif
- CMD: @frama-c@ -wp-share ./share -wp-msg-key no-cache-info,success-only -wp-par 1 -wp-session @PTEST_DIR@/oracle@PTEST_CONFIG@/@PTEST_NAME@.@PTEST_NUMBER@.session -wp-cache replay -wp-cache-dir ./cache
- OPT: -eva -eva-msg-key=-summary -then -wp -then -no-eva -warn-unsigned-overflow -wp
+ OPT: -load-module eva,scope -no-wp -eva -eva-msg-key=-summary -then -wp -then -no-eva -warn-unsigned-overflow -wp
*/
/* run.config
diff --git a/src/plugins/wp/tests/wp_plugin/stmt.c b/src/plugins/wp/tests/wp_plugin/stmt.c
index 02e1eddff383cc8b84a70ba560c0f62f60cd4d4d..58e04b9d85fccbba9f6eb09c1738dffc0c98768c 100644
--- a/src/plugins/wp/tests/wp_plugin/stmt.c
+++ b/src/plugins/wp/tests/wp_plugin/stmt.c
@@ -4,7 +4,7 @@
/* run.config_qualif
OPT: -load-module report -then -report
- EXECNOW: LOG stmt.log LOG f.dot LOG f_default_for_stmt_2.dot LOG g.dot LOG g_default_for_stmt_11.dot @frama-c@ -no-autoload-plugins -load-module wp -wp-precond-weakening -wp -wp-model Dump -wp-out tests/wp_plugin/result_qualif -wp-msg-key no-cache-info @PTEST_FILE@ 1> tests/wp_plugin/result_qualif/stmt.log
+ EXECNOW: LOG stmt.log LOG f.dot LOG f_default_for_stmt_2.dot LOG g.dot LOG g_default_for_stmt_11.dot @frama-c@ -no-autoload-plugins -load-module wp -wp-precond-weakening -wp -wp-model Dump -wp-out tests/wp_plugin/result_qualif -wp-msg-key shell @PTEST_FILE@ 1> tests/wp_plugin/result_qualif/stmt.log
*/
/*@ ensures a > 0 ==> \result == a + b;
diff --git a/src/plugins/wp/tests/wp_typed/oracle/user_init.0.res.oracle b/src/plugins/wp/tests/wp_typed/oracle/user_init.0.res.oracle
index 999fd9b742431831e08595ee7463dfe6d0469cd4..e8e6e13bc582dde43cd57df852ee32ea1fc163ed 100644
--- a/src/plugins/wp/tests/wp_typed/oracle/user_init.0.res.oracle
+++ b/src/plugins/wp/tests/wp_typed/oracle/user_init.0.res.oracle
@@ -8,7 +8,6 @@
[wp] [CFG] Goal init_t2_v2_exits : Valid (Unreachable)
[wp] [CFG] Goal init_t2_v3_exits : Valid (Unreachable)
[wp] Warning: Missing RTE guards
-[wp] Computing [100 goals...]
------------------------------------------------------------
Function init
------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_typed/oracle/user_init.1.res.oracle b/src/plugins/wp/tests/wp_typed/oracle/user_init.1.res.oracle
index e6996907f9367101bc6353be0b7ae906cb568ba9..aa1fcfbc2ff78b19adb1a83efb7a8576a3e8bf19 100644
--- a/src/plugins/wp/tests/wp_typed/oracle/user_init.1.res.oracle
+++ b/src/plugins/wp/tests/wp_typed/oracle/user_init.1.res.oracle
@@ -8,7 +8,6 @@
[wp] [CFG] Goal init_t2_v2_exits : Valid (Unreachable)
[wp] [CFG] Goal init_t2_v3_exits : Valid (Unreachable)
[wp] Warning: Missing RTE guards
-[wp] Computing [100 goals...]
------------------------------------------------------------
Function init
------------------------------------------------------------
diff --git a/src/plugins/wp/wp_parameters.ml b/src/plugins/wp/wp_parameters.ml
index 47bb5721b38c1de4331503410072ae87c26c7265..448ff335f59df0604294f560f9f87b957e69a5ae 100644
--- a/src/plugins/wp/wp_parameters.ml
+++ b/src/plugins/wp/wp_parameters.ml
@@ -639,18 +639,18 @@ module Cache = String
- 'replay': update mode with no cache update\n\
- 'rebuild': always run provers and update cache\n\
- 'offline': use cache but never run provers\n\
- This option is overriden by environment variable FRAMAC_WP_CACHE,\
- unless -wp-no-cache-env is used."
+ You can also use the environment variable FRAMAC_WP_CACHE instead."
end)
let () = Parameter_customize.set_group wp_prover
-module CacheEnv = True
+module CacheEnv = False
(struct
let option_name = "-wp-cache-env"
- let help = "Use environment variables for cache.\n\
+ let help = "Gives environment variables precedence over command line\n\
+ for cache management:\n\
- FRAMAC_WP_CACHE overrides -wp-cache\n\
- FRAMAC_WP_CACHEDIR overrides -wp-cache-dir\n\
- This is the behavior by default."
+ Disabled by default."
end)
let () = Parameter_customize.set_group wp_prover
@@ -661,8 +661,15 @@ module CacheDir = String
let default = ""
let help =
"Specify global cache directory (no cleanup mode).\n\
- This option is overriden by environment variable FRAMAC_WP_CACHEDIR,\
- unless -wp-no-cache-env is used."
+ By default, cache entries are stored in the WP session directory.\n\
+ You can also use the environment variable FRAMAC_WP_CACHEDIR instead."
+ end)
+
+let () = Parameter_customize.set_group wp_prover
+module CachePrint = False
+ (struct
+ let option_name = "-wp-cache-print"
+ let help = "Show cache directory"
end)
let () = Parameter_customize.set_group wp_prover
diff --git a/src/plugins/wp/wp_parameters.mli b/src/plugins/wp/wp_parameters.mli
index e1fd65d39590ff076d0f33ec8c496d5af590f9bf..f998977a9af312b4433ba49926a80b811f21a275 100644
--- a/src/plugins/wp/wp_parameters.mli
+++ b/src/plugins/wp/wp_parameters.mli
@@ -112,6 +112,7 @@ module RunAllProvers: Parameter_sig.Bool
module Cache: Parameter_sig.String
module CacheEnv: Parameter_sig.Bool
module CacheDir: Parameter_sig.String
+module CachePrint: Parameter_sig.Bool
module Drivers: Parameter_sig.String_list
module Script: Parameter_sig.String
module UpdateScript: Parameter_sig.Bool
diff --git a/src/plugins/wp/wpo.ml b/src/plugins/wp/wpo.ml
index 4f85fe8851bc0fa7025f2cffd3fb2d1ca71b67bc..1d6649a3de7511c3c8a26c798fa5d9a90c25877d 100644
--- a/src/plugins/wp/wpo.ml
+++ b/src/plugins/wp/wpo.ml
@@ -659,7 +659,7 @@ let add g =
Gmap.iter
(fun _ ws -> WPOset.iter (fun _ -> incr added) ws)
system.wpo_idx ;
- if not (Wp_parameters.has_dkey VCS.dkey_no_goals_info) then
+ if not (Wp_parameters.has_dkey VCS.dkey_shell) then
Wp_parameters.feedback ~ontty:`Feedback "Computing [%d goals...]" !added ;
added := 0 ;
end ;
diff --git a/tests/float/fval_test.i b/tests/float/fval_test.i
index cabb28768924493f9964d6329934d0356b2e5143..f480093ba099eda06a2fdca943402b02945c5cce 100644
--- a/tests/float/fval_test.i
+++ b/tests/float/fval_test.i
@@ -1,6 +1,6 @@
/* run.config
- EXECNOW: make -s @PTEST_DIR@/@PTEST_NAME@.cmxs
- OPT: -load-module @PTEST_DIR@/@PTEST_NAME@
+ MODULE: @PTEST_DIR@/@PTEST_NAME@.cmxs
+ OPT:
*/
/* run.config*
DONTRUN:
diff --git a/tests/spec/oracle/preprocess_dos.res.oracle b/tests/spec/oracle/preprocess_dos.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..875a7eae29550f7c2bc14248aa39a15614d7216a
--- /dev/null
+++ b/tests/spec/oracle/preprocess_dos.res.oracle
@@ -0,0 +1,10 @@
+[kernel] Parsing tests/spec/preprocess_dos.c (with preprocessing)
+/* Generated by Frama-C */
+int main(void)
+{
+ int a = 0;
+ /*@ assert a ≡ 0; */ ;
+ return a;
+}
+
+
diff --git a/tests/spec/preprocess_dos.c.in b/tests/spec/preprocess_dos.c.in
new file mode 100644
index 0000000000000000000000000000000000000000..abae8ad374b159cd60043731308ac57df1f96498
--- /dev/null
+++ b/tests/spec/preprocess_dos.c.in
@@ -0,0 +1,13 @@
+/* run.config*
+COMMENT: Don't edit directly preprocess_dos.c, but preprocess_dos.c.in
+@DONTRUN@
+OPT: -cpp-command="@PTEST_DIR@/@PTEST_NAME@.sh @UNIX2DOS@ %i %o" -cpp-frama-c-compliant -print
+*/
+
+int main() {
+ int a = 0;
+ /*@
+ assert a == 0;
+ */
+ return a;
+}
diff --git a/tests/spec/preprocess_dos.sh b/tests/spec/preprocess_dos.sh
new file mode 100755
index 0000000000000000000000000000000000000000..a63a982d043b5847b333d4e556892393f97c8a7d
--- /dev/null
+++ b/tests/spec/preprocess_dos.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+gcc -C -E -I. -o $3 $2
+$1 -q $3
diff --git a/tests/syntax/oracle/pragma.res.oracle b/tests/syntax/oracle/pragma.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..1a8c485d86b2bf01d6e9983907bd8509e92f82fe
--- /dev/null
+++ b/tests/syntax/oracle/pragma.res.oracle
@@ -0,0 +1,12 @@
+[kernel] Parsing tests/syntax/pragma.i (no preprocessing)
+[kernel] tests/syntax/pragma.i:1: Warning:
+ Unsupported argument for pragma pack push directive: `_CRT_PACKING'.
+/* Generated by Frama-C */
+int main(void)
+{
+ int __retres;
+ __retres = 0;
+ return __retres;
+}
+
+
diff --git a/tests/syntax/pragma.i b/tests/syntax/pragma.i
new file mode 100644
index 0000000000000000000000000000000000000000..c8dc1b09b1865c15352e9e78f8f5ed3a6ddfee49
--- /dev/null
+++ b/tests/syntax/pragma.i
@@ -0,0 +1,5 @@
+#pragma pack(push, _CRT_PACKING)
+#pragma pack(pop)
+int main() {
+ return 0;
+}
diff --git a/tests/value/oracle/strings.0.res.oracle b/tests/value/oracle/strings.0.res.oracle
deleted file mode 100644
index f82b23c4a9e97d73b6db8238c657b9fee2c9bc52..0000000000000000000000000000000000000000
--- a/tests/value/oracle/strings.0.res.oracle
+++ /dev/null
@@ -1,152 +0,0 @@
-[kernel] Parsing tests/value/strings.i (no preprocessing)
-[eva] Analyzing a complete application starting at main1
-[eva] Computing initial state
-[eva] Initial state computed
-[eva:initial-state] Values of globals at initialization
- s1[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- [6] ∈ {32}
- [7] ∈ {119}
- [8] ∈ {111}
- [9] ∈ {114}
- [10] ∈ {108}
- [11] ∈ {100}
- [12] ∈ {0}
- s2[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- s5 ∈ {0}
- s6 ∈ {0}
- cc ∈ {97}
- Q ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0}
- U ∈ {0}
- V ∈ {0}
- W ∈ {0}
- X ∈ {0}
- Y ∈ {0}
- Z ∈ {0}
- s3 ∈ {{ "tutu" }}
- s4 ∈ {{ "tutu" }}
- s7 ∈ {{ "hello\000 world" }}
- s8 ∈ {{ "hello" }}
-[eva] computing for function u <- main1.
- Called from tests/value/strings.i:39.
-[kernel:annot:missing-spec] tests/value/strings.i:39: Warning:
- Neither code nor specification for function u, generating default assigns from the prototype
-[eva] using specification for function u
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:39: Warning:
- out of bounds read. assert \valid_read(p - 4);
-[eva] computing for function u <- main1.
- Called from tests/value/strings.i:42.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:42: Warning:
- out of bounds read. assert \valid_read(p + 12);
-[eva] computing for function u <- main1.
- Called from tests/value/strings.i:44.
-[eva] Done for function u
-[eva] computing for function u <- main1.
- Called from tests/value/strings.i:48.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:48: Warning:
- out of bounds read. assert \valid_read(p - 4);
-[eva] computing for function u <- main1.
- Called from tests/value/strings.i:53.
-[eva] Done for function u
-[eva] computing for function strcpy <- main1.
- Called from tests/value/strings.i:53.
-[eva:alarm] tests/value/strings.i:21: Warning:
- out of bounds write.
- assert \valid(tmp_unroll_46);
- (tmp_unroll_46 from ldst++)
-[kernel] tests/value/strings.i:21: Warning:
- all target addresses were invalid. This path is assumed to be dead.
-[eva] Recording results for strcpy
-[eva] Done for function strcpy
-[eva] computing for function strlen <- main1.
- Called from tests/value/strings.i:58.
-[eva] Recording results for strlen
-[eva] Done for function strlen
-[eva] Recording results for main1
-[eva] done for function main1
-[eva] tests/value/strings.i:21:
- assertion 'Eva,mem_access' got final status invalid.
-[eva] tests/value/strings.i:39:
- assertion 'Eva,mem_access' got final status invalid.
-[eva] tests/value/strings.i:42:
- assertion 'Eva,mem_access' got final status invalid.
-[eva] ====== VALUES COMPUTED ======
-[eva:final-states] Values at end of function strcpy:
- NON TERMINATING FUNCTION
-[eva:final-states] Values at end of function strlen:
- s ∈ {{ &s1[6] }}
- l ∈ {5}
-[eva:final-states] Values at end of function main1:
- s1[0] ∈ {104}
- [1] ∈ {101}
- [2] ∈ {108}
- [3] ∈ {97}
- [4] ∈ {111}
- [5] ∈ {0}
- [6] ∈ {97}
- [7] ∈ {119}
- [8] ∈ {111}
- [9] ∈ {114}
- [10] ∈ {108}
- [11] ∈ {100}
- [12] ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0; 101}
- p ∈ {{ &s1[5] ; &s2[3] }}
- __retres ∈ {5}
-[from] Computing for function strcpy
-[from] Non-terminating function strcpy (no dependencies)
-[from] Done for function strcpy
-[from] Computing for function strlen
-[from] Done for function strlen
-[from] Computing for function main1
-[from] Computing for function u <-main1
-[from] Done for function u
-[from] Done for function main1
-[from] ====== DEPENDENCIES COMPUTED ======
- These dependencies hold at termination for the executions that terminate:
-[from] Function strcpy:
- NON TERMINATING - NO EFFECTS
-[from] Function strlen:
- \result FROM s1[0..4]; s
-[from] Function u:
- \result FROM \nothing
-[from] Function main1:
- s1{[3]; [6]} FROM cc
- R FROM \nothing (and SELF)
- S FROM \nothing (and SELF)
- T FROM s1[1] (and SELF)
- \result FROM s1{[0..2]; [4]}; cc
-[from] ====== END OF DEPENDENCIES ======
-[inout] Out (internal) for function strcpy:
- src; ldst; b[0..4]; tmp_unroll_46; tmp_1_unroll_46; tmp_0_unroll_46;
- tmp_unroll_49; tmp_1_unroll_49; tmp_0_unroll_49; tmp_unroll_52;
- tmp_1_unroll_52; tmp_0_unroll_52; tmp_unroll_55; tmp_1_unroll_55;
- tmp_0_unroll_55; tmp_unroll_58; tmp_1_unroll_58; tmp_0_unroll_58;
- tmp_unroll_61; tmp_1_unroll_61; tmp_0_unroll_61
-[inout] Inputs for function strcpy:
- a[0..5]
-[inout] Out (internal) for function strlen:
- s; l; tmp_unroll_106; tmp_unroll_109; tmp_unroll_112; tmp_unroll_115;
- tmp_unroll_118; tmp_unroll_121
-[inout] Inputs for function strlen:
- s1[0..5]
-[inout] Out (internal) for function main1:
- s1{[3]; [6]}; R; S; T; p; tmp; tmp_0; tmp_1; tmp_2; a[0..9]; b[0..4];
- tmp_3; tmp_4; __retres
-[inout] Inputs for function main1:
- s1[0..5]; cc
diff --git a/tests/value/oracle/strings.1.res.oracle b/tests/value/oracle/strings.1.res.oracle
deleted file mode 100644
index cf5a4433579e96602d54f51e4a713f7e1c7fe4d9..0000000000000000000000000000000000000000
--- a/tests/value/oracle/strings.1.res.oracle
+++ /dev/null
@@ -1,145 +0,0 @@
-[kernel] Parsing tests/value/strings.i (no preprocessing)
-[eva] Analyzing a complete application starting at main6
-[eva] Computing initial state
-[eva] Initial state computed
-[eva:initial-state] Values of globals at initialization
- s1[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- [6] ∈ {32}
- [7] ∈ {119}
- [8] ∈ {111}
- [9] ∈ {114}
- [10] ∈ {108}
- [11] ∈ {100}
- [12] ∈ {0}
- s2[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- s5 ∈ {0}
- s6 ∈ {0}
- cc ∈ {97}
- Q ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0}
- U ∈ {0}
- V ∈ {0}
- W ∈ {0}
- X ∈ {0}
- Y ∈ {0}
- Z ∈ {0}
- s3 ∈ {{ "tutu" }}
- s4 ∈ {{ "tutu" }}
- s7 ∈ {{ "hello\000 world" }}
- s8 ∈ {{ "hello" }}
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:72.
-[kernel:annot:missing-spec] tests/value/strings.i:72: Warning:
- Neither code nor specification for function u, generating default assigns from the prototype
-[eva] using specification for function u
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:73: Warning:
- pointer comparison. assert \pointer_comparable((void *)s3, (void *)s4);
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:74.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:76.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:78.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:79: Warning:
- pointer comparison. assert \pointer_comparable((void *)s7, (void *)s8);
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:80.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:82.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:83: Warning:
- pointer comparison.
- assert \pointer_comparable((void *)(s7 + 1), (void *)(s8 + 1));
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:84.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:86.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:87.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:88.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:89.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:89.
-[eva] Done for function u
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:90.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:91: Warning:
- pointer comparison. assert \pointer_comparable((void *)s5, (void *)s6);
-[eva] computing for function u <- main6.
- Called from tests/value/strings.i:92.
-[eva] Done for function u
-[eva:alarm] tests/value/strings.i:93: Warning:
- pointer comparison.
- assert \pointer_comparable((void *)("oh, hello" + 4), (void *)s7);
-[eva] Recording results for main6
-[eva] done for function main6
-[eva] ====== VALUES COMPUTED ======
-[eva:final-states] Values at end of function main6:
- s5 ∈ {{ "tutu" ; "hello" }}
- s6 ∈ {{ "tutu" ; "tutu" ; "hello" }}
- cc ∈ {116}
- Q ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0}
- U ∈ {0}
- V ∈ {0}
- W ∈ {0}
- X ∈ {0; 1}
- Y ∈ {0; 1}
- Z ∈ {0; 1}
- s ∈ {{ "toto" }}
- __retres ∈ {116}
-[from] Computing for function main6
-[from] Computing for function u <-main6
-[from] Done for function u
-[from] Done for function main6
-[from] ====== DEPENDENCIES COMPUTED ======
- These dependencies hold at termination for the executions that terminate:
-[from] Function u:
- \result FROM \nothing
-[from] Function main6:
- s5 FROM s3; s8
- s6 FROM s3; s4; s8
- cc FROM "toto"[bits 0 to 7]
- Q FROM s7 (and SELF)
- R FROM s3; s4 (and SELF)
- S FROM \nothing (and SELF)
- T FROM s3 (and SELF)
- U FROM s7; s8 (and SELF)
- V FROM s4; s7 (and SELF)
- W FROM s7; s8 (and SELF)
- X FROM s3 (and SELF)
- Y FROM s3; s8 (and SELF)
- Z FROM s3; s4; s8 (and SELF)
- \result FROM "toto"[bits 0 to 7]
-[from] ====== END OF DEPENDENCIES ======
-[inout] Out (internal) for function main6:
- s5; s6; cc; Q; R; S; T; U; V; W; X; Y; Z; s; tmp; tmp_0; tmp_1; tmp_2;
- tmp_3; tmp_4; tmp_5; tmp_6; tmp_7; tmp_8; tmp_9; tmp_10; tmp_11; tmp_12;
- tmp_13; tmp_14; __retres
-[inout] Inputs for function main6:
- s5; s6; cc; s3; s4; s7; s8; "toto"[bits 0 to 7]
diff --git a/tests/value/oracle/strings.2.res.oracle b/tests/value/oracle/strings.2.res.oracle
deleted file mode 100644
index daea0f31e7890e94748290ff519bbb703421d0d5..0000000000000000000000000000000000000000
--- a/tests/value/oracle/strings.2.res.oracle
+++ /dev/null
@@ -1,69 +0,0 @@
-[kernel] Parsing tests/value/strings.i (no preprocessing)
-[eva] Analyzing a complete application starting at main7
-[eva] Computing initial state
-[eva] Initial state computed
-[eva:initial-state] Values of globals at initialization
- s1[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- [6] ∈ {32}
- [7] ∈ {119}
- [8] ∈ {111}
- [9] ∈ {114}
- [10] ∈ {108}
- [11] ∈ {100}
- [12] ∈ {0}
- s2[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- s5 ∈ {0}
- s6 ∈ {0}
- cc ∈ {97}
- Q ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0}
- U ∈ {0}
- V ∈ {0}
- W ∈ {0}
- X ∈ {0}
- Y ∈ {0}
- Z ∈ {0}
- s3 ∈ {{ "tutu" }}
- s4 ∈ {{ "tutu" }}
- s7 ∈ {{ "hello\000 world" }}
- s8 ∈ {{ "hello" }}
-[eva:alarm] tests/value/strings.i:101: Warning:
- out of bounds write. assert \valid(tmp);
- (tmp from f?s5 + 2:& c)
-[eva:alarm] tests/value/strings.i:103: Warning:
- out of bounds write. assert \valid(s5);
-[eva:alarm] tests/value/strings.i:105: Warning:
- out of bounds write. assert \valid(s6);
-[eva] Recording results for main7
-[eva] done for function main7
-[eva] ====== VALUES COMPUTED ======
-[eva:final-states] Values at end of function main7:
- s5 ∈ {{ &c }}
- s6 ∈ {{ &c }}
- R ∈ {84}
- c ∈ {116}
- __retres ∈ {116}
-[from] Computing for function main7
-[from] Done for function main7
-[from] ====== DEPENDENCIES COMPUTED ======
- These dependencies hold at termination for the executions that terminate:
-[from] Function main7:
- s5 FROM s3; d
- s6 FROM s3; e
- R FROM s3; d; f
- \result FROM s4; "tutu"[bits 0 to 7]
-[from] ====== END OF DEPENDENCIES ======
-[inout] Out (internal) for function main7:
- s5; s6; R; c; tmp; __retres
-[inout] Inputs for function main7:
- s5; s6; cc; s3; s4; "tutu"[bits 0 to 7]
diff --git a/tests/value/oracle/strings.3.res.oracle b/tests/value/oracle/strings.3.res.oracle
deleted file mode 100644
index 45b2847cf8c3a1cad1f6fa02a39b71c5a17765df..0000000000000000000000000000000000000000
--- a/tests/value/oracle/strings.3.res.oracle
+++ /dev/null
@@ -1,114 +0,0 @@
-[kernel] Parsing tests/value/strings.i (no preprocessing)
-[eva] Analyzing a complete application starting at main8
-[eva] Computing initial state
-[eva] Initial state computed
-[eva:initial-state] Values of globals at initialization
- s1[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- [6] ∈ {32}
- [7] ∈ {119}
- [8] ∈ {111}
- [9] ∈ {114}
- [10] ∈ {108}
- [11] ∈ {100}
- [12] ∈ {0}
- s2[0] ∈ {104}
- [1] ∈ {101}
- [2..3] ∈ {108}
- [4] ∈ {111}
- [5] ∈ {0}
- s5 ∈ {0}
- s6 ∈ {0}
- cc ∈ {97}
- Q ∈ {0}
- R ∈ {0}
- S ∈ {0}
- T ∈ {0}
- U ∈ {0}
- V ∈ {0}
- W ∈ {0}
- X ∈ {0}
- Y ∈ {0}
- Z ∈ {0}
- s3 ∈ {{ "tutu" }}
- s4 ∈ {{ "tutu" }}
- s7 ∈ {{ "hello\000 world" }}
- s8 ∈ {{ "hello" }}
-[eva] computing for function assigns <- main8.
- Called from tests/value/strings.i:127.
-[eva] using specification for function assigns
-[eva] tests/value/strings.i:121: Warning:
- no \from part for clause 'assigns *(p + (0 .. s - 1));'
-[eva] Done for function assigns
-[eva] computing for function strcmp <- main8.
- Called from tests/value/strings.i:128.
-[eva:alarm] tests/value/strings.i:114: Warning:
- out of bounds read. assert \valid_read(tmp_0);
- (tmp_0 from s2_0++)
-[eva] Recording results for strcmp
-[eva] Done for function strcmp
-[eva] Recording results for main8
-[eva] done for function main8
-[eva] ====== VALUES COMPUTED ======
-[eva:final-states] Values at end of function strcmp:
- s1_0 ∈ {{ &long_chain + [0..29] }}
- s2_0 ∈ {{ &tc + [0..29] }}
- __retres ∈ [-223..121]
-[eva:final-states] Values at end of function main8:
- tc[0..29] ∈ [--..--]
- long_chain[0] ∈ {114}
- [1] ∈ {101}
- [2] ∈ {97}
- [3..4] ∈ {108}
- [5] ∈ {121}
- [6] ∈ {32}
- [7] ∈ {114}
- [8] ∈ {101}
- [9] ∈ {97}
- [10..11] ∈ {108}
- [12] ∈ {121}
- [13] ∈ {32}
- [14] ∈ {114}
- [15] ∈ {101}
- [16] ∈ {97}
- [17..18] ∈ {108}
- [19] ∈ {121}
- [20] ∈ {32}
- [21] ∈ {108}
- [22] ∈ {111}
- [23] ∈ {110}
- [24] ∈ {103}
- [25] ∈ {32}
- [26] ∈ {99}
- [27] ∈ {104}
- [28] ∈ {97}
- [29] ∈ {105}
- [30] ∈ {110}
- [31] ∈ {0}
- x ∈ [-223..121]
-[from] Computing for function strcmp
-[from] Done for function strcmp
-[from] Computing for function main8
-[from] Computing for function assigns <-main8
-[from] Done for function assigns
-[from] Done for function main8
-[from] ====== DEPENDENCIES COMPUTED ======
- These dependencies hold at termination for the executions that terminate:
-[from] Function assigns:
- tc[0..29] FROM ANYTHING(origin:Unknown) (and SELF)
-[from] Function strcmp:
- \result FROM s1_0; s2_0; tc[0..29]; long_chain[0..30]
-[from] Function main8:
- \result FROM ANYTHING(origin:Unknown)
-[from] ====== END OF DEPENDENCIES ======
-[inout] Out (internal) for function strcmp:
- s1_0; s2_0; tmp; tmp_0; __retres
-[inout] Inputs for function strcmp:
- tc[0..29]; long_chain[0..30]
-[inout] Out (internal) for function main8:
- tc[0..29]; long_chain[0..31]; x
-[inout] Inputs for function main8:
- ANYTHING(origin:Unknown)
diff --git a/tests/value/oracle/strings.res.oracle b/tests/value/oracle/strings.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..5e410a5aad929dc5580b43a5d42f68a94d87a59f
--- /dev/null
+++ b/tests/value/oracle/strings.res.oracle
@@ -0,0 +1,428 @@
+[kernel] Parsing tests/value/strings.i (no preprocessing)
+[eva] Analyzing a complete application starting at main
+[eva] Computing initial state
+[eva] Initial state computed
+[eva:initial-state] Values of globals at initialization
+ nondet ∈ [--..--]
+ s1[0] ∈ {104}
+ [1] ∈ {101}
+ [2..3] ∈ {108}
+ [4] ∈ {111}
+ [5] ∈ {0}
+ [6] ∈ {32}
+ [7] ∈ {119}
+ [8] ∈ {111}
+ [9] ∈ {114}
+ [10] ∈ {108}
+ [11] ∈ {100}
+ [12] ∈ {0}
+ s2[0] ∈ {104}
+ [1] ∈ {101}
+ [2..3] ∈ {108}
+ [4] ∈ {111}
+ [5] ∈ {0}
+ s3 ∈ {{ "tutu" }}
+ s4 ∈ {{ "tutu" }}
+ s5 ∈ {0}
+ s6 ∈ {0}
+ s7 ∈ {{ "hello\000 world" }}
+ s8 ∈ {{ "hello" }}
+ cc ∈ {97}
+ Q ∈ {0}
+ R ∈ {0}
+ S ∈ {0}
+ T ∈ {0}
+ U ∈ {0}
+ V ∈ {0}
+ W ∈ {0}
+ X ∈ {0}
+ Y ∈ {0}
+ Z ∈ {0}
+[eva] computing for function string_reads <- main.
+ Called from tests/value/strings.i:142.
+[eva] computing for function u <- string_reads <- main.
+ Called from tests/value/strings.i:39.
+[kernel:annot:missing-spec] tests/value/strings.i:39: Warning:
+ Neither code nor specification for function u, generating default assigns from the prototype
+[eva] using specification for function u
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:39: Warning:
+ out of bounds read. assert \valid_read(p - 4);
+[eva] computing for function u <- string_reads <- main.
+ Called from tests/value/strings.i:42.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:42: Warning:
+ out of bounds read. assert \valid_read(p + 12);
+[eva] computing for function u <- string_reads <- main.
+ Called from tests/value/strings.i:44.
+[eva] Done for function u
+[eva] computing for function u <- string_reads <- main.
+ Called from tests/value/strings.i:48.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:48: Warning:
+ out of bounds read. assert \valid_read(p - 4);
+[eva] computing for function u <- string_reads <- main.
+ Called from tests/value/strings.i:53.
+[eva] Done for function u
+[eva] computing for function strcpy <- string_reads <- main.
+ Called from tests/value/strings.i:53.
+[eva:alarm] tests/value/strings.i:23: Warning:
+ out of bounds write.
+ assert \valid(tmp_unroll_46);
+ (tmp_unroll_46 from ldst++)
+[kernel] tests/value/strings.i:23: Warning:
+ all target addresses were invalid. This path is assumed to be dead.
+[eva] Recording results for strcpy
+[eva] Done for function strcpy
+[eva] computing for function strlen <- string_reads <- main.
+ Called from tests/value/strings.i:58.
+[eva] Recording results for strlen
+[eva] Done for function strlen
+[eva] Recording results for string_reads
+[eva] Done for function string_reads
+[eva] computing for function string_writes <- main.
+ Called from tests/value/strings.i:143.
+[eva:alarm] tests/value/strings.i:64: Warning:
+ out of bounds write. assert \valid(tmp);
+ (tmp from nondet?s5 + 2:& c)
+[eva:alarm] tests/value/strings.i:66: Warning:
+ out of bounds write. assert \valid(s5);
+[eva:alarm] tests/value/strings.i:68: Warning:
+ out of bounds write. assert \valid(s6);
+[eva] Recording results for string_writes
+[eva] Done for function string_writes
+[eva:locals-escaping] tests/value/strings.i:143: Warning:
+ locals {c} escaping the scope of string_writes through s5
+[eva:locals-escaping] tests/value/strings.i:143: Warning:
+ locals {c} escaping the scope of string_writes through s6
+[eva] computing for function string_comparison <- main.
+ Called from tests/value/strings.i:144.
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:78.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:79: Warning:
+ pointer comparison. assert \pointer_comparable((void *)s3, (void *)s4);
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:80.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:82.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:84.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:85: Warning:
+ pointer comparison. assert \pointer_comparable((void *)s7, (void *)s8);
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:86.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:88.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:89: Warning:
+ pointer comparison.
+ assert \pointer_comparable((void *)(s7 + 1), (void *)(s8 + 1));
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:90.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:92.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:93.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:94.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:95.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:95.
+[eva] Done for function u
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:96.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:97: Warning:
+ pointer comparison. assert \pointer_comparable((void *)s5, (void *)s6);
+[eva] computing for function u <- string_comparison <- main.
+ Called from tests/value/strings.i:98.
+[eva] Done for function u
+[eva:alarm] tests/value/strings.i:99: Warning:
+ pointer comparison.
+ assert \pointer_comparable((void *)("oh, hello" + 4), (void *)s7);
+[eva] Recording results for string_comparison
+[eva] Done for function string_comparison
+[eva] computing for function wide_string_comparison <- main.
+ Called from tests/value/strings.i:145.
+[eva:alarm] tests/value/strings.i:111: Warning:
+ pointer comparison. assert \pointer_comparable((void *)w1, (void *)w2);
+[eva:alarm] tests/value/strings.i:114: Warning:
+ pointer comparison. assert \pointer_comparable((void *)w2, (void *)w3);
+[eva] Recording results for wide_string_comparison
+[eva] Done for function wide_string_comparison
+[eva] computing for function long_chain <- main.
+ Called from tests/value/strings.i:146.
+[eva] computing for function assigns <- long_chain <- main.
+ Called from tests/value/strings.i:135.
+[eva] using specification for function assigns
+[eva] tests/value/strings.i:129: Warning:
+ no \from part for clause 'assigns *(p + (0 .. s - 1));'
+[eva] Done for function assigns
+[eva] computing for function strcmp <- long_chain <- main.
+ Called from tests/value/strings.i:136.
+[eva:alarm] tests/value/strings.i:123: Warning:
+ out of bounds read. assert \valid_read(tmp_0);
+ (tmp_0 from s2_0++)
+[eva] Recording results for strcmp
+[eva] Done for function strcmp
+[eva] Recording results for long_chain
+[eva] Done for function long_chain
+[eva] Recording results for main
+[eva] done for function main
+[eva] tests/value/strings.i:23:
+ assertion 'Eva,mem_access' got final status invalid.
+[eva] tests/value/strings.i:39:
+ assertion 'Eva,mem_access' got final status invalid.
+[eva] tests/value/strings.i:42:
+ assertion 'Eva,mem_access' got final status invalid.
+[eva] ====== VALUES COMPUTED ======
+[eva:final-states] Values at end of function strcmp:
+ s1_0 ∈ {{ &long_chain_0 + [0..29] }}
+ s2_0 ∈ {{ &tc + [0..29] }}
+ __retres ∈ [-223..121]
+[eva:final-states] Values at end of function long_chain:
+ tc[0..29] ∈ [--..--]
+ long_chain_0[0] ∈ {114}
+ [1] ∈ {101}
+ [2] ∈ {97}
+ [3..4] ∈ {108}
+ [5] ∈ {121}
+ [6] ∈ {32}
+ [7] ∈ {114}
+ [8] ∈ {101}
+ [9] ∈ {97}
+ [10..11] ∈ {108}
+ [12] ∈ {121}
+ [13] ∈ {32}
+ [14] ∈ {114}
+ [15] ∈ {101}
+ [16] ∈ {97}
+ [17..18] ∈ {108}
+ [19] ∈ {121}
+ [20] ∈ {32}
+ [21] ∈ {108}
+ [22] ∈ {111}
+ [23] ∈ {110}
+ [24] ∈ {103}
+ [25] ∈ {32}
+ [26] ∈ {99}
+ [27] ∈ {104}
+ [28] ∈ {97}
+ [29] ∈ {105}
+ [30] ∈ {110}
+ [31] ∈ {0}
+ x ∈ [-223..121]
+[eva:final-states] Values at end of function strcpy:
+ NON TERMINATING FUNCTION
+[eva:final-states] Values at end of function string_writes:
+ s5 ∈ {{ &c }}
+ s6 ∈ {{ &c }}
+ R ∈ {84}
+ c ∈ {116}
+ __retres ∈ {116}
+[eva:final-states] Values at end of function strlen:
+ s ∈ {{ &s1[6] }}
+ l ∈ {5}
+[eva:final-states] Values at end of function string_comparison:
+ s5 ∈ {{ "tutu" ; "hello" }}
+ s6 ∈ {{ "tutu" ; "tutu" ; "hello" }}
+ cc ∈ {116}
+ Q ∈ {0}
+ R ∈ {0; 84}
+ S ∈ {0}
+ T ∈ {0; 101}
+ U ∈ {0}
+ V ∈ {0}
+ W ∈ {0}
+ X ∈ {0; 1}
+ Y ∈ {0; 1}
+ Z ∈ {0; 1}
+ s ∈ {{ "toto" }}
+ __retres ∈ {116}
+[eva:final-states] Values at end of function string_reads:
+ s1[0] ∈ {104}
+ [1] ∈ {101}
+ [2] ∈ {108}
+ [3] ∈ {97}
+ [4] ∈ {111}
+ [5] ∈ {0}
+ [6] ∈ {97}
+ [7] ∈ {119}
+ [8] ∈ {111}
+ [9] ∈ {114}
+ [10] ∈ {108}
+ [11] ∈ {100}
+ [12] ∈ {0}
+ R ∈ {0}
+ S ∈ {0}
+ T ∈ {0; 101}
+ p ∈ {{ &s1[5] ; &s2[3] }}
+ __retres ∈ {5}
+[eva:final-states] Values at end of function wide_string_comparison:
+ w1 ∈ {{ L"abcdef" }}
+ w2 ∈ {{ L"def" }}
+ w3 ∈ {{ L"abc" }}
+ res ∈ {0}
+[eva:final-states] Values at end of function main:
+ s1[0] ∈ {104}
+ [1] ∈ {101}
+ [2] ∈ {108}
+ [3] ∈ {97}
+ [4] ∈ {111}
+ [5] ∈ {0}
+ [6] ∈ {97}
+ [7] ∈ {119}
+ [8] ∈ {111}
+ [9] ∈ {114}
+ [10] ∈ {108}
+ [11] ∈ {100}
+ [12] ∈ {0}
+ s5 ∈ {{ "tutu" ; "hello" }}
+ s6 ∈ {{ "tutu" ; "tutu" ; "hello" }}
+ cc ∈ {116}
+ Q ∈ {0}
+ R ∈ {0; 84}
+ S ∈ {0}
+ T ∈ {0; 101}
+ U ∈ {0}
+ V ∈ {0}
+ W ∈ {0}
+ X ∈ {0; 1}
+ Y ∈ {0; 1}
+ Z ∈ {0; 1}
+[from] Computing for function strcmp
+[from] Done for function strcmp
+[from] Computing for function long_chain
+[from] Computing for function assigns <-long_chain
+[from] Done for function assigns
+[from] Done for function long_chain
+[from] Computing for function strcpy
+[from] Non-terminating function strcpy (no dependencies)
+[from] Done for function strcpy
+[from] Computing for function string_writes
+[from] Done for function string_writes
+[from] Computing for function strlen
+[from] Done for function strlen
+[from] Computing for function string_comparison
+[from] Computing for function u <-string_comparison
+[from] Done for function u
+[from] Done for function string_comparison
+[from] Computing for function string_reads
+[from] Done for function string_reads
+[from] Computing for function wide_string_comparison
+[from] Done for function wide_string_comparison
+[from] Computing for function main
+[from] Done for function main
+[from] ====== DEPENDENCIES COMPUTED ======
+ These dependencies hold at termination for the executions that terminate:
+[from] Function assigns:
+ tc[0..29] FROM ANYTHING(origin:Unknown) (and SELF)
+[from] Function strcmp:
+ \result FROM s1_0; s2_0; tc[0..29]; long_chain_0[0..30]
+[from] Function long_chain:
+ \result FROM ANYTHING(origin:Unknown)
+[from] Function strcpy:
+ NON TERMINATING - NO EFFECTS
+[from] Function string_writes:
+ s5 FROM nondet; s3
+ s6 FROM nondet; s3
+ R FROM nondet; s3
+ \result FROM s4; "tutu"[bits 0 to 7]
+[from] Function strlen:
+ \result FROM s1[0..4]; s
+[from] Function u:
+ \result FROM \nothing
+[from] Function string_comparison:
+ s5 FROM s3; s8
+ s6 FROM s3; s4; s8
+ cc FROM "toto"[bits 0 to 7]
+ Q FROM s7 (and SELF)
+ R FROM s3; s4 (and SELF)
+ S FROM \nothing (and SELF)
+ T FROM s3 (and SELF)
+ U FROM s7; s8 (and SELF)
+ V FROM s4; s7 (and SELF)
+ W FROM s7; s8 (and SELF)
+ X FROM s3 (and SELF)
+ Y FROM s3; s8 (and SELF)
+ Z FROM s3; s4; s8 (and SELF)
+ \result FROM "toto"[bits 0 to 7]
+[from] Function string_reads:
+ s1{[3]; [6]} FROM cc
+ R FROM \nothing (and SELF)
+ S FROM \nothing (and SELF)
+ T FROM s1[1] (and SELF)
+ \result FROM s1{[0..2]; [4]}; cc
+[from] Function wide_string_comparison:
+ \result FROM \nothing
+[from] Function main:
+ s1{[3]; [6]} FROM cc
+ s5 FROM s3; s8
+ s6 FROM s3; s4; s8
+ cc FROM "toto"[bits 0 to 7]
+ Q FROM s7 (and SELF)
+ R FROM nondet; s3; s4
+ S FROM \nothing (and SELF)
+ T FROM s1[1]; s3 (and SELF)
+ U FROM s7; s8 (and SELF)
+ V FROM s4; s7 (and SELF)
+ W FROM s7; s8 (and SELF)
+ X FROM s3 (and SELF)
+ Y FROM s3; s8 (and SELF)
+ Z FROM s3; s4; s8 (and SELF)
+[from] ====== END OF DEPENDENCIES ======
+[inout] Out (internal) for function strcmp:
+ s1_0; s2_0; tmp; tmp_0; __retres
+[inout] Inputs for function strcmp:
+ tc[0..29]; long_chain_0[0..30]
+[inout] Out (internal) for function long_chain:
+ tc[0..29]; long_chain_0[0..31]; x
+[inout] Inputs for function long_chain:
+ ANYTHING(origin:Unknown)
+[inout] Out (internal) for function strcpy:
+ src; ldst; b[0..4]; tmp_unroll_46; tmp_1_unroll_46; tmp_0_unroll_46;
+ tmp_unroll_49; tmp_1_unroll_49; tmp_0_unroll_49; tmp_unroll_52;
+ tmp_1_unroll_52; tmp_0_unroll_52; tmp_unroll_55; tmp_1_unroll_55;
+ tmp_0_unroll_55; tmp_unroll_58; tmp_1_unroll_58; tmp_0_unroll_58;
+ tmp_unroll_61; tmp_1_unroll_61; tmp_0_unroll_61
+[inout] Inputs for function strcpy:
+ a[0..5]
+[inout] Out (internal) for function string_writes:
+ s5; s6; R; c; tmp; __retres
+[inout] Inputs for function string_writes:
+ nondet; s3; s4; s5; s6; cc; "tutu"[bits 0 to 7]
+[inout] Out (internal) for function strlen:
+ s; l; tmp_unroll_106; tmp_unroll_109; tmp_unroll_112; tmp_unroll_115;
+ tmp_unroll_118; tmp_unroll_121
+[inout] Inputs for function strlen:
+ s1[0..5]
+[inout] Out (internal) for function string_comparison:
+ s5; s6; cc; Q; R; S; T; U; V; W; X; Y; Z; s; tmp; tmp_0; tmp_1; tmp_2;
+ tmp_3; tmp_4; tmp_5; tmp_6; tmp_7; tmp_8; tmp_9; tmp_10; tmp_11; tmp_12;
+ tmp_13; tmp_14; __retres
+[inout] Inputs for function string_comparison:
+ s3; s4; s5; s6; s7; s8; cc; "toto"[bits 0 to 7]
+[inout] Out (internal) for function string_reads:
+ s1{[3]; [6]}; R; S; T; p; tmp; tmp_0; tmp_1; tmp_2; a[0..9]; b[0..4];
+ tmp_3; tmp_4; __retres
+[inout] Inputs for function string_reads:
+ s1[0..5]; cc
+[inout] Out (internal) for function wide_string_comparison:
+ w1; w2; w3; res
+[inout] Inputs for function wide_string_comparison:
+ \nothing
+[inout] Out (internal) for function main:
+ s1{[3]; [6]}; s5; s6; cc; Q; R; S; T; U; V; W; X; Y; Z
+[inout] Inputs for function main:
+ ANYTHING(origin:Unknown)
diff --git a/tests/value/oracle/unit_tests.res.oracle b/tests/value/oracle/unit_tests.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..35ce0d1ac58fd2746a03ac9dc7555281595b0f8e
--- /dev/null
+++ b/tests/value/oracle/unit_tests.res.oracle
@@ -0,0 +1,2 @@
+[kernel] Parsing tests/value/unit_tests.i (no preprocessing)
+[eva] Runs unit tests: only faulty operations will be printed.
diff --git a/tests/value/strings.i b/tests/value/strings.i
index f4ca9828f5bfd47f713c0fab8528a6a56cb64c6b..0f6087161602aca84fc72009a38b18e5ccb75272 100644
--- a/tests/value/strings.i
+++ b/tests/value/strings.i
@@ -1,21 +1,23 @@
/* run.config*
- GCC:
- STDOPT: #"-main main1 -eva-no-builtins-auto"
- STDOPT: #"-main main6 -eva-no-builtins-auto"
- STDOPT: #"-main main7 -eva-no-builtins-auto"
- STDOPT: #"-main main8 -slevel-function strcmp:50 -eva-no-builtins-auto"
+ STDOPT: #"-eva-no-builtins-auto -eva-slevel-function strcmp:50"
*/
+
+volatile int nondet;
+
char s1[]="hello\000 world";
char s2[]="hello";
+char *s3="tutu";
+char *s4="tutu";
char *s5, *s6;
+char *s7="hello\x00 world";
+char *s8="hello";
int u(void);
char cc = 'a';
char Q, R, S, T, U, V, W, X, Y, Z;
-char *strcpy(char*dst, char*src)
-{
+char *strcpy(char*dst, char*src) {
char* ldst=dst;
/*@ loop pragma UNROLL 20; */
while (*ldst++ = *src++)
@@ -23,8 +25,7 @@ char *strcpy(char*dst, char*src)
return dst;
}
-unsigned int strlen(char *s)
-{
+unsigned int strlen(char *s) {
unsigned int l=0;
/*@ loop pragma UNROLL 20; */
while(*s++ != 0)
@@ -32,8 +33,7 @@ unsigned int strlen(char *s)
return l;
}
-int main1(void)
-{
+int string_reads() {
char *p;
p = &s1[3];
if (u()) R=*(p-4);
@@ -48,24 +48,30 @@ int main1(void)
if (u()) T=*(p-4);
{
- char a[10] = "Not ok";
- char b [5];
- if (u()) strcpy(b,a);
- }
-
+ char a[10] = "Not ok";
+ char b [5];
+ if (u()) strcpy(b,a);
+ }
+
s1[3]=cc;
s1[6]=cc;
return strlen(s1);
}
+int string_writes() {
+ char c=-1;
+ if (nondet) s5 = s3; else s5 = &c;
+ *(nondet ? s5 + 2 : &c) = 'T';
+ R=c;
+ *s5=' ';
+ if (nondet) s6 = s3+1; else s6 = &c;
+ *s6=cc;
+ c=*s4;
+ return c;
+}
-char *s3="tutu";
-char *s4="tutu";
-char *s7="hello\x00 world";
-char *s8="hello";
-int main6(void)
-{
+int string_comparison() {
char *s;
s = "toto";
cc = *s;
@@ -82,29 +88,32 @@ int main6(void)
if (u())
W = (s7 + 1 == s8 + 1);
if (u())
- X = (s3 == s3);
- s5 = (u()?s3:s8);
+ X = (s3 == s3);
+ s5 = (u()?s3:s8);
if (u())
Y = ((u()?s3:s8) == s5);
- s6 = (u()?(u()?s3:s8):s4);
+ s6 = (u()?(u()?s3:s8):s4);
if (u())
Z = (s5 == s6);
if (u())
- Q = ("oh, hello"+4 == s7);
+ Q = ("oh, hello"+4 == s7);
return cc;
}
-int main7(int d, int e, int f)
-{
- char c=-1;
- if (d) s5 = s3; else s5 = &c;
- *(f ? s5 + 2 : &c) = 'T';
- R=c;
- *s5=' ';
- if (e) s6 = s3+1; else s6 = &c;
- *s6=cc;
- c=*s4;
- return c;
+/* Currently, Eva does not support wide string comparisons: alarms are emitted
+ on any comparison involving a wide string. Tests are minimal for now. */
+int wide_string_comparison() {
+ char* w1 = L"abcdef";
+ char* w2 = L"def";
+ char* w3 = L"abc";
+ int res = 0;
+ /* Must emit a comparison alarm. */
+ if (w1 == w2)
+ res = 1;
+ /* Ideally, should not emit a comparison alarm. */
+ if (w2 == w3)
+ res = -1;
+ return res;
}
int strcmp(const char *s1, const char *s2)
@@ -117,14 +126,22 @@ int strcmp(const char *s1, const char *s2)
return (*(unsigned char *)s1 - *(unsigned char *)--s2);
}
-
//@ assigns p[0..s-1]; ensures \initialized(&p[0..s-1]);
void assigns(char *p, unsigned int s);
-int main8() {
+int long_chain() {
char tc[30];
char long_chain[] = "really really really long chain";
assigns(&tc[0],30);
int x = strcmp(long_chain, tc);
return x;
}
+
+
+void main() {
+ string_reads ();
+ string_writes ();
+ string_comparison ();
+ wide_string_comparison ();
+ long_chain ();
+}
diff --git a/tests/value/unit_tests.i b/tests/value/unit_tests.i
new file mode 100644
index 0000000000000000000000000000000000000000..f480093ba099eda06a2fdca943402b02945c5cce
--- /dev/null
+++ b/tests/value/unit_tests.i
@@ -0,0 +1,7 @@
+/* run.config
+ MODULE: @PTEST_DIR@/@PTEST_NAME@.cmxs
+ OPT:
+*/
+/* run.config*
+ DONTRUN:
+*/
diff --git a/tests/value/unit_tests.ml b/tests/value/unit_tests.ml
new file mode 100644
index 0000000000000000000000000000000000000000..48e3b3405bcb13af995b3a50f15aebaa64b09b54
--- /dev/null
+++ b/tests/value/unit_tests.ml
@@ -0,0 +1,3 @@
+(* Programmatic tests of Eva, run by unit_tests.i. *)
+
+let () = Db.Main.extend Eva.Unit_tests.run