diff --git a/.Makefile.lint b/.Makefile.lint
index da13c5b801adb0d708f45d53ccdbb29c84280886..cdddb760969cc6f1075006562db65d2c0cc5af02 100644
--- a/.Makefile.lint
+++ b/.Makefile.lint
@@ -101,8 +101,6 @@ ML_LINT_KO+=src/kernel_services/ast_printing/cil_types_debug.ml
ML_LINT_KO+=src/kernel_services/ast_printing/cil_types_debug.mli
ML_LINT_KO+=src/kernel_services/ast_printing/cprint.ml
ML_LINT_KO+=src/kernel_services/ast_printing/cprint.mli
-ML_LINT_KO+=src/kernel_services/ast_printing/description.ml
-ML_LINT_KO+=src/kernel_services/ast_printing/description.mli
ML_LINT_KO+=src/kernel_services/ast_printing/logic_print.ml
ML_LINT_KO+=src/kernel_services/ast_printing/printer.ml
ML_LINT_KO+=src/kernel_services/ast_printing/printer_api.mli
@@ -194,8 +192,6 @@ ML_LINT_KO+=src/libraries/stdlib/FCSet.ml
ML_LINT_KO+=src/libraries/stdlib/FCSet.mli
ML_LINT_KO+=src/libraries/stdlib/extlib.ml
ML_LINT_KO+=src/libraries/stdlib/extlib.mli
-ML_LINT_KO+=src/libraries/stdlib/integer.ml
-ML_LINT_KO+=src/libraries/stdlib/integer.mli
ML_LINT_KO+=src/libraries/utils/bag.ml
ML_LINT_KO+=src/libraries/utils/binary_cache.ml
ML_LINT_KO+=src/libraries/utils/bitvector.ml
@@ -222,8 +218,6 @@ ML_LINT_KO+=src/libraries/utils/qstack.ml
ML_LINT_KO+=src/libraries/utils/qstack.mli
ML_LINT_KO+=src/libraries/utils/rangemap.ml
ML_LINT_KO+=src/libraries/utils/rangemap.mli
-ML_LINT_KO+=src/libraries/utils/rich_text.ml
-ML_LINT_KO+=src/libraries/utils/rich_text.mli
ML_LINT_KO+=src/libraries/utils/task.ml
ML_LINT_KO+=src/libraries/utils/task.mli
ML_LINT_KO+=src/libraries/utils/vector.ml
diff --git a/Makefile b/Makefile
index 62da0160b06b00127cd4a487da4e77d2e5a8486b..1668a9d2777578fe6d3149774945eaedd101e369 100644
--- a/Makefile
+++ b/Makefile
@@ -188,7 +188,7 @@ THEME_ICONS_FLAT:= \
$(addprefix share/theme/flat/,$(THEME_ICON_NAMES))
ROOT_LIBC_DIR:= share/libc
-LIBC_SUBDIRS:= sys netinet linux net arpa
+LIBC_SUBDIRS:= sys netinet net arpa
LIBC_DIR:= $(ROOT_LIBC_DIR) $(addprefix $(ROOT_LIBC_DIR)/,$(LIBC_SUBDIRS))
LIBC_FILES:= \
$(wildcard share/*.h share/*.c) \
@@ -576,6 +576,7 @@ KERNEL_CMO=\
src/kernel_services/abstract_interp/lmap_bitwise.cmo \
src/kernel_services/visitors/visitor.cmo \
src/kernel_services/ast_data/statuses_by_call.cmo \
+ src/kernel_services/ast_printing/printer_tag.cmo \
$(PLUGIN_TYPES_CMO_LIST) \
src/kernel_services/plugin_entry_points/db.cmo \
src/libraries/utils/command.cmo \
@@ -732,6 +733,7 @@ endif
GENERATED+=src/plugins/gui/gtk_compat.ml
SINGLE_GUI_CMO:= \
+ wutil_once \
gtk_compat \
$(WTOOLKIT) \
$(SOURCEVIEWCOMPAT) \
@@ -1421,9 +1423,9 @@ $(foreach file,$(LONELY_TESTS_ML_FILES),\
$(foreach file,$(LONELY_TESTS_ML_FILES),\
$(eval $(file:%.ml=%.cmxs): OFLAGS+=-I $(dir $(file))))
.PRECIOUS: $(LONELY_TESTS_ML_FILES:%.ml=%.cmx) \
- $(LONELY_TESTS_DYN_FILES:%.ml=%.cmxs) \
- $(LONELY_TESTS_BYTE_FILES:%.ml=%.cmo) \
- $(LONELY_TESTS_BYTE_FILES:%.ml=%.cmi)
+ $(LONELY_TESTS_ML_FILES:%.ml=%.cmxs) \
+ $(LONELY_TESTS_ML_FILES:%.ml=%.cmo) \
+ $(LONELY_TESTS_ML_FILES:%.ml=%.cmi)
bin/ocamldep_transitive_closure: devel_tools/ocamldep_transitive_closure.ml
$(OCAMLOPT) -package ocamlgraph -package str -linkpkg -o $@ $<
@@ -1874,7 +1876,6 @@ install:: install-lib
$(MKDIR) $(FRAMAC_DATADIR)/theme/flat
$(MKDIR) $(FRAMAC_DATADIR)/libc/sys
$(MKDIR) $(FRAMAC_DATADIR)/libc/netinet
- $(MKDIR) $(FRAMAC_DATADIR)/libc/linux
$(MKDIR) $(FRAMAC_DATADIR)/libc/net
$(MKDIR) $(FRAMAC_DATADIR)/libc/arpa
$(PRINT_INSTALL) shared files
@@ -1917,7 +1918,6 @@ install:: install-lib
$(CP) share/libc/arpa/*.[ch] $(FRAMAC_DATADIR)/libc/arpa
$(CP) share/libc/net/*.[ch] $(FRAMAC_DATADIR)/libc/net
$(CP) share/libc/netinet/*.[ch] $(FRAMAC_DATADIR)/libc/netinet
- $(CP) share/libc/linux/*.[ch] $(FRAMAC_DATADIR)/libc/linux
$(PRINT_INSTALL) binaries
$(CP) bin/toplevel.$(OCAMLBEST) $(BINDIR)/frama-c$(EXE)
$(CP) bin/toplevel.byte$(EXE) $(BINDIR)/frama-c.byte$(EXE)
diff --git a/headers/header_spec.txt b/headers/header_spec.txt
index 80fdaba048b40b8b8a639b45aa48a1aa6e8077dc..dd34d6c7e782c8eb929528844e2b9d94027eb2d7 100644
--- a/headers/header_spec.txt
+++ b/headers/header_spec.txt
@@ -224,13 +224,7 @@ share/libc/inttypes.c: CEA_LGPL
share/libc/inttypes.h: CEA_LGPL
share/libc/iso646.h: CEA_LGPL
share/libc/libgen.h: CEA_LGPL
-share/libc/libintl.h: CEA_LGPL
share/libc/limits.h: CEA_LGPL
-share/libc/linux/fs.h: CEA_LGPL
-share/libc/linux/if_addr.h: CEA_LGPL
-share/libc/linux/if_netlink.h: CEA_LGPL
-share/libc/linux/netlink.h: CEA_LGPL
-share/libc/linux/rtnetlink.h: CEA_LGPL
share/libc/locale.c: CEA_LGPL
share/libc/locale.h: CEA_LGPL
share/libc/malloc.h: CEA_LGPL
@@ -243,9 +237,6 @@ share/libc/net/if.h: CEA_LGPL
share/libc/netdb.c: CEA_LGPL
share/libc/netdb.h: CEA_LGPL
share/libc/netinet/in.h: CEA_LGPL
-share/libc/netinet/in_systm.h: CEA_LGPL
-share/libc/netinet/ip.h: CEA_LGPL
-share/libc/netinet/ip_icmp.h: CEA_LGPL
share/libc/netinet/tcp.h: CEA_LGPL
share/libc/nl_types.h: CEA_LGPL
share/libc/poll.h: CEA_LGPL
@@ -273,7 +264,6 @@ share/libc/sys/file.h: CEA_LGPL
share/libc/sys/ioctl.h: CEA_LGPL
share/libc/sys/ipc.h: CEA_LGPL
share/libc/sys/mman.h: CEA_LGPL
-share/libc/sys/param.h: CEA_LGPL
share/libc/sys/random.h: CEA_LGPL
share/libc/sys/resource.h: CEA_LGPL
share/libc/sys/select.h: CEA_LGPL
@@ -281,7 +271,6 @@ share/libc/sys/shm.h: CEA_LGPL
share/libc/sys/signal.h: CEA_LGPL
share/libc/sys/socket.h: CEA_LGPL
share/libc/sys/stat.h: CEA_LGPL
-share/libc/sys/sysctl.h: CEA_LGPL
share/libc/sys/time.h: CEA_LGPL
share/libc/sys/times.h: CEA_LGPL
share/libc/sys/timex.h: CEA_LGPL
@@ -293,9 +282,8 @@ share/libc/sys/wait.h: CEA_LGPL
share/libc/syslog.h: CEA_LGPL
share/libc/termios.h: CEA_LGPL
share/libc/tgmath.h: CEA_LGPL
-share/libc/time.h: CEA_LGPL
share/libc/time.c: CEA_LGPL
-share/libc/uchar.h: CEA_LGPL
+share/libc/time.h: CEA_LGPL
share/libc/unistd.h: CEA_LGPL
share/libc/utime.h: CEA_LGPL
share/libc/utmpx.h: CEA_LGPL
@@ -514,6 +502,8 @@ src/kernel_services/ast_printing/printer.mli: CEA_LGPL
src/kernel_services/ast_printing/printer_api.mli: CEA_LGPL
src/kernel_services/ast_printing/printer_builder.ml: CEA_LGPL
src/kernel_services/ast_printing/printer_builder.mli: CEA_LGPL
+src/kernel_services/ast_printing/printer_tag.ml: CEA_LGPL
+src/kernel_services/ast_printing/printer_tag.mli: CEA_LGPL
src/kernel_services/ast_queries/README.md: .ignore
src/kernel_services/ast_queries/ast_info.ml: CEA_LGPL
src/kernel_services/ast_queries/ast_info.mli: CEA_LGPL
@@ -824,6 +814,8 @@ src/plugins/gui/wtext.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/gui/wtext.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/gui/wutil.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/gui/wutil.mli: CEA_LGPL_OR_PROPRIETARY
+src/plugins/gui/wutil_once.ml: CEA_LGPL_OR_PROPRIETARY
+src/plugins/gui/wutil_once.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/impact/Impact.mli: CEA_LGPL_OR_PROPRIETARY
src/plugins/impact/compute_impact.ml: CEA_LGPL_OR_PROPRIETARY
src/plugins/impact/compute_impact.mli: CEA_LGPL_OR_PROPRIETARY
diff --git a/share/libc/__fc_define_fd_set_t.h b/share/libc/__fc_define_fd_set_t.h
index 9a33dcec7e78b5abeb7c54179c2b3764ce8fb84e..993cba5b5176794c71b1b3c62febc5879a323fc9 100644
--- a/share/libc/__fc_define_fd_set_t.h
+++ b/share/libc/__fc_define_fd_set_t.h
@@ -24,8 +24,10 @@
#define __FC_DEFINE_FD_SET_T
#include "features.h"
__PUSH_FC_STDLIB
+#define FD_SETSIZE 1024
+#define NFDBITS (8 * sizeof(long))
__BEGIN_DECLS
-typedef struct {char __fc_fd_set;} fd_set;
+typedef struct { long __fc_fd_set[FD_SETSIZE / NFDBITS]; } fd_set;
/*@
requires valid_fdset: \valid(fdset);
@@ -62,6 +64,5 @@ extern void FD_ZERO(fd_set *fdset);
#define FD_ZERO FD_ZERO
__END_DECLS
-#define FD_SETSIZE 1024
__POP_FC_STDLIB
#endif
diff --git a/share/libc/libgen.h b/share/libc/libgen.h
index 1abe66dd28cc3ebb3d7847b1ba63074c4296f798..1cfded11784bc2d799ac973f9f810aea06022a2f 100644
--- a/share/libc/libgen.h
+++ b/share/libc/libgen.h
@@ -20,13 +20,36 @@
/* */
/**************************************************************************/
-#ifndef __FC_LIBGEN
-#define __FC_LIBGEN
+#ifndef __FC_LIBGEN_H
+#define __FC_LIBGEN_H
#include "features.h"
+#include "__fc_machdep.h"
+#include "__fc_string_axiomatic.h"
__PUSH_FC_STDLIB
__BEGIN_DECLS
+extern char __fc_basename[__FC_PATH_MAX];
+char *__fc_p_basename = __fc_basename;
+
+/*@ // missing: assigns path[0 ..], __fc_p_basename[0 ..] \from 'filesystem';
+ requires null_or_valid_string_path: path == \null || valid_read_string(path);
+ assigns path[0 ..], __fc_basename[0 ..] \from path[0 ..], __fc_basename[0 ..];
+ assigns \result \from __fc_p_basename, path;
+ ensures result_points_to_internal_storage_or_path:
+ \subset(\result, {__fc_p_basename, path});
+*/
extern char *basename(char *path);
+
+extern char __fc_dirname[__FC_PATH_MAX];
+char *__fc_p_dirname = __fc_dirname;
+
+/*@ // missing: assigns path[0 ..], __fc_p_dirname[0 ..] \from 'filesystem';
+ requires null_or_valid_string_path: path == \null || valid_read_string(path);
+ assigns path[0 ..], __fc_dirname[0 ..] \from path[0 ..], __fc_dirname[0 ..];
+ assigns \result \from __fc_p_dirname, path;
+ ensures result_points_to_internal_storage_or_path:
+ \subset(\result, {__fc_p_dirname, path});
+*/
extern char *dirname(char *path);
__END_DECLS
diff --git a/share/libc/libintl.h b/share/libc/libintl.h
deleted file mode 100644
index f79f14d0fcfdb0482bfa524301ebc55a9f38eb53..0000000000000000000000000000000000000000
--- a/share/libc/libintl.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_LIBINTL_H
-#define __FC_LIBINTL_H
-
-#endif
diff --git a/share/libc/linux/fs.h b/share/libc/linux/fs.h
deleted file mode 100644
index c0b6d361f2d781309374dd3c9efcc86cd1d8196c..0000000000000000000000000000000000000000
--- a/share/libc/linux/fs.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_LINUX_FS_H
-#define __FC_LINUX_FS_H
-/* TODO */
-
-#endif
-
diff --git a/share/libc/linux/if_addr.h b/share/libc/linux/if_addr.h
deleted file mode 100644
index 51efee090ac1788a4db5851a27a04303a0efb0d5..0000000000000000000000000000000000000000
--- a/share/libc/linux/if_addr.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_LINUX_IF_ADDR_H
-#define __FC_LINUX_IF_ADDR_H
-
-#endif
diff --git a/share/libc/linux/if_netlink.h b/share/libc/linux/if_netlink.h
deleted file mode 100644
index 276d067832a672962cb593531e6b95205c857db2..0000000000000000000000000000000000000000
--- a/share/libc/linux/if_netlink.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_IF_NETLINK_H
-#define __FC_IF_NETLINK_H
-
-#endif
-
diff --git a/share/libc/linux/netlink.h b/share/libc/linux/netlink.h
deleted file mode 100644
index 1ddd191ab29e8419a1ef0dedfbcdbc6ac73c56ce..0000000000000000000000000000000000000000
--- a/share/libc/linux/netlink.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_LINUX_NETLINK_H
-#define __FC_LINUX_NETLINK_H
-
-
-
-#endif
diff --git a/share/libc/linux/rtnetlink.h b/share/libc/linux/rtnetlink.h
deleted file mode 100644
index 7ea2a119e9f92904ec8d82044c36b2eb89273995..0000000000000000000000000000000000000000
--- a/share/libc/linux/rtnetlink.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_LINUX_RTNETLINK_H
-#define __FC_LINUX_RTNETLINK_H
-
-
-#endif
-
diff --git a/share/libc/netdb.c b/share/libc/netdb.c
index cfdea15cc7fb7a6bf9c09f96fd8ab6c851b0bb1c..d8380dd1d5f6b020e89a629b2d7f93414c43660c 100644
--- a/share/libc/netdb.c
+++ b/share/libc/netdb.c
@@ -25,6 +25,7 @@
#include "netinet/in.h"
#include "stdlib.h"
#include "stddef.h"
+#include "string.h"
#include "errno.h"
#include "__fc_builtin.h"
__PUSH_FC_STDLIB
@@ -76,4 +77,84 @@ int getaddrinfo(
}
}
+#define __FC_MAX_HOST_ADDRS 2
+#define __FC_MAX_HOST_ALIASES 2
+#define __FC_HOSTBUF_SIZE 128
+#define __FC_QUERYBUF_SIZE 128
+struct __fc_gethostbyname {
+ struct hostent host;
+ unsigned char host_addr[sizeof(struct in_addr)];
+ char *h_addr_ptrs[__FC_MAX_HOST_ADDRS + 1];
+ char *host_aliases[__FC_MAX_HOST_ALIASES];
+ char hostbuf[__FC_HOSTBUF_SIZE];
+};
+
+struct __fc_gethostbyname __fc_ghbn;
+
+int res_search(const char *dname, int class, int type,
+ char *answer, int anslen) {
+ for (int i = 0; i < anslen-1; i++) {
+ answer[i] = Frama_C_char_interval(CHAR_MIN, CHAR_MAX);
+ }
+ answer[anslen-1] = 0;
+ return Frama_C_interval(-1, anslen);
+}
+
+struct hostent *gethostbyname(const char *name) {
+ char buf[__FC_QUERYBUF_SIZE];
+ const char *cp;
+ int n;
+ __fc_ghbn.host.h_addrtype = AF_INET;
+ __fc_ghbn.host.h_length = sizeof(struct in_addr);
+
+ // Disallow names consisting only of digits/dots, unless they end in a dot
+ if (*name >= '0' && *name <= '9') {
+ for (cp = name;; ++cp) {
+ if (!*cp) {
+ struct in_addr addr;
+
+ if (*--cp == '.') break;
+
+ // All-numeric, no dot at the end. Fake up a hostent as if we'd actually done a lookup.
+ addr.s_addr = inet_addr(name);
+ if (addr.s_addr == INADDR_NONE) return NULL;
+
+ memcpy(__fc_ghbn.host_addr, &addr, __fc_ghbn.host.h_length);
+ strncpy(__fc_ghbn.hostbuf, name, __FC_HOSTBUF_SIZE - 1);
+ __fc_ghbn.hostbuf[__FC_HOSTBUF_SIZE - 1] = '\0';
+ __fc_ghbn.host.h_name = __fc_ghbn.hostbuf;
+ __fc_ghbn.host.h_aliases = __fc_ghbn.host_aliases;
+ __fc_ghbn.host_aliases[0] = NULL;
+ __fc_ghbn.h_addr_ptrs[0] = (char *) __fc_ghbn.host_addr;
+ __fc_ghbn.h_addr_ptrs[1] = NULL;
+ __fc_ghbn.host.h_addr_list = __fc_ghbn.h_addr_ptrs;
+
+ return &__fc_ghbn.host;
+ }
+
+ if (*cp < '0' && *cp > '9' && *cp != '.') break;
+ }
+ }
+
+ n = res_search(name, 1, 1, buf, sizeof(buf));
+ if (n < 0) return NULL;
+
+ if (Frama_C_nondet(0, 1)) return NULL;
+ else {
+ struct in_addr addr;
+ addr.s_addr = inet_addr(name);
+ memcpy(__fc_ghbn.host_addr, &addr, __fc_ghbn.host.h_length);
+ strncpy(__fc_ghbn.hostbuf, name, __FC_HOSTBUF_SIZE - 1);
+ __fc_ghbn.hostbuf[__FC_HOSTBUF_SIZE - 1] = '\0';
+ __fc_ghbn.host.h_name = __fc_ghbn.hostbuf;
+ __fc_ghbn.host.h_aliases = __fc_ghbn.host_aliases;
+ __fc_ghbn.host_aliases[0] = NULL;
+ __fc_ghbn.h_addr_ptrs[0] = (char *) __fc_ghbn.host_addr;
+ __fc_ghbn.h_addr_ptrs[1] = NULL;
+ __fc_ghbn.host.h_addr_list = __fc_ghbn.h_addr_ptrs;
+ return &__fc_ghbn.host;
+ }
+}
+
+
__POP_FC_STDLIB
diff --git a/share/libc/netinet/in_systm.h b/share/libc/netinet/in_systm.h
deleted file mode 100644
index 1beabb1cae1d68c9448bc06e4f4d61a4f0a9eb99..0000000000000000000000000000000000000000
--- a/share/libc/netinet/in_systm.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_NETINET_SYSTM_H
-#define __FC_NETINET_SYSTM_H
-
-#endif
diff --git a/share/libc/netinet/ip.h b/share/libc/netinet/ip.h
deleted file mode 100644
index 0c469cede7533dbba94f67cb2e601c6d585a8539..0000000000000000000000000000000000000000
--- a/share/libc/netinet/ip.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_NETINET_IP_H
-#define __FC_NETINET_IP_H
-
-#endif
diff --git a/share/libc/netinet/ip_icmp.h b/share/libc/netinet/ip_icmp.h
deleted file mode 100644
index 78e895961d9fba583731860cac67c0cee72f8e9e..0000000000000000000000000000000000000000
--- a/share/libc/netinet/ip_icmp.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_NETINET_IP_ICMP_H
-#define __FC_NETINET_IP_ICMP_H
-
-#endif
-
diff --git a/share/libc/stdlib.c b/share/libc/stdlib.c
index 72dd24cc238641547c7bdcd5f4855cc7f099936f..d9c40ce3983b2ad6ee27c15da26fba50d6889453 100644
--- a/share/libc/stdlib.c
+++ b/share/libc/stdlib.c
@@ -187,4 +187,19 @@ int unsetenv(const char *name)
char __fc_strerror[64];
#endif
+// Note: this implementation does not check the alignment, since it cannot
+// currently be specified in the memory model of most plug-ins
+int posix_memalign(void **memptr, size_t alignment, size_t size) {
+ // By default, specifications in the libc are ignored for defined functions,
+ // and since we do not actually use alignment, we need to check its validity.
+ // The assertion below is the requires in the specification.
+ /*@ assert alignment_is_a_suitable_power_of_two:
+ alignment >= sizeof(void*) &&
+ ((size_t)alignment & ((size_t)alignment - 1)) == 0;
+ */
+ *memptr = malloc(size);
+ if (!*memptr) return ENOMEM;
+ return 0;
+}
+
__POP_FC_STDLIB
diff --git a/share/libc/stdlib.h b/share/libc/stdlib.h
index acdbbf87f659a078e3a89127771f0089eb11704c..e69ed2aa5b7dd00a0a704e72dc6e398b8036dfe2 100644
--- a/share/libc/stdlib.h
+++ b/share/libc/stdlib.h
@@ -594,6 +594,34 @@ extern size_t wcstombs(char * restrict s,
size_t n);
+// Note: this specification should ideally use a more specific predicate,
+// such as 'is_allocable_aligned(alignment, size)'.
+/*@
+ requires valid_memptr: \valid(memptr);
+ requires alignment_is_a_suitable_power_of_two:
+ alignment >= sizeof(void*) &&
+ ((size_t)alignment & ((size_t)alignment - 1)) == 0;
+ allocates *memptr;
+ assigns __fc_heap_status \from indirect:alignment, size, __fc_heap_status;
+ assigns \result \from indirect:alignment, indirect:size,
+ indirect:__fc_heap_status;
+ behavior allocation:
+ assumes can_allocate: is_allocable(size);
+ assigns __fc_heap_status \from indirect:alignment, size, __fc_heap_status;
+ assigns \result \from indirect:alignment, indirect:size,
+ indirect:__fc_heap_status;
+ ensures allocation: \fresh(*memptr,size);
+ ensures result_zero: \result == 0;
+ behavior no_allocation:
+ assumes cannot_allocate: !is_allocable(size);
+ assigns \result \from indirect:alignment;
+ allocates \nothing;
+ ensures result_non_zero: \result < 0 || \result > 0;
+ complete behaviors;
+ disjoint behaviors;
+ */
+extern int posix_memalign(void **memptr, size_t alignment, size_t size);
+
__END_DECLS
__POP_FC_STDLIB
diff --git a/share/libc/strings.h b/share/libc/strings.h
index f1091001fc4b1bf80ad01cf123ceba53cda6431e..6b6e42dd4a04bc6f7e626dc1acf7a4995a2acc53 100644
--- a/share/libc/strings.h
+++ b/share/libc/strings.h
@@ -35,6 +35,7 @@ extern void bcopy(const void *, void *, size_t);
/*@ requires valid_memory_area: \valid (((char*) s)+(0 .. n-1));
assigns ((char*) s)[0 .. n-1] \from \nothing;
+ ensures s_initialized:initialization:\initialized(((char*) s)+(0 .. n-1));
ensures zero_initialized: \subset(((char*) s)[0 .. n-1], {0}); */
extern void bzero(void *s, size_t n);
extern int ffs(int);
diff --git a/share/libc/sys/param.h b/share/libc/sys/param.h
deleted file mode 100644
index 93e55b1606cdcd6eeec17f095f0e59482a8a8729..0000000000000000000000000000000000000000
--- a/share/libc/sys/param.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-#ifndef __FC_SYS_PARAM_H__
-#define __FC_SYS_PARAM_H__
-/* Only deprecated programs use this header. Add whatever is needed
- for this program to compile. */
-
-#endif
diff --git a/share/libc/sys/sysctl.h b/share/libc/sys/sysctl.h
deleted file mode 100644
index bd14e7820b752c14887790e628692ff83d7d4a87..0000000000000000000000000000000000000000
--- a/share/libc/sys/sysctl.h
+++ /dev/null
@@ -1,22 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
diff --git a/share/libc/time.h b/share/libc/time.h
index 2906228203f8ab73f85cc8fa4eaab65be8f95a39..52c4455579fc3c1269c131021b2582575c5fd52e 100644
--- a/share/libc/time.h
+++ b/share/libc/time.h
@@ -105,7 +105,7 @@ extern time_t mktime(struct tm *timeptr);
extern time_t time(time_t *timer);
char __fc_ctime[26];
-char * const __fc_p_ctime = &__fc_ctime;
+char * const __fc_p_ctime = __fc_ctime;
extern char *asctime(const struct tm *timeptr);
diff --git a/share/libc/uchar.h b/share/libc/uchar.h
deleted file mode 100644
index 61011a2d979742edf859fbf2c054aa58c83d4023..0000000000000000000000000000000000000000
--- a/share/libc/uchar.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/**************************************************************************/
-/* */
-/* This file is part of Frama-C. */
-/* */
-/* Copyright (C) 2007-2019 */
-/* 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). */
-/* */
-/**************************************************************************/
-
-/* ISO C: 7.24 */
-#ifndef __FC_UCHAR
-#define __FC_UCHAR
-
-#endif
diff --git a/src/kernel_internals/typing/cabs2cil.ml b/src/kernel_internals/typing/cabs2cil.ml
index 984fef51c452bc6ffd8b2cab48b3e9c352650d11..cccda3a9169be72d7c7d2202aec9827b2b477ada 100644
--- a/src/kernel_internals/typing/cabs2cil.ml
+++ b/src/kernel_internals/typing/cabs2cil.ml
@@ -3297,12 +3297,17 @@ let rec collectInitializer
(if len_used then newtype else thistype),
reads
- | TComp (comp, _, _), CompoundPre (pMaxIdx, pArray) when comp.cstruct ->
+ | TComp (comp, _, _) as t,
+ CompoundPre (pMaxIdx, pArray) when comp.cstruct ->
Kernel.debug ~dkey
"Initialization of an object of type %a with at least %d components"
Cil_printer.pp_typ thistype !pMaxIdx;
let rec collect (idx: int) reads = function
[] -> [], reads
+ | [ _ ] when Cil.has_flexible_array_member t && idx > !pMaxIdx ->
+ (* Do not add an empty initializer to the FAM, making an ill-formed
+ AST. An explicit initialization is allowed in gcc-mode. *)
+ [], reads
| f :: restf ->
if f.fname = missingFieldName then
collect (idx + 1) reads restf
@@ -5365,7 +5370,7 @@ and isIntegerConstant ghost (aexp) : int option =
match doExp (ghost_local_env ghost) true aexp (AExp None) with
| (_, c, e, _) when isEmpty c -> begin
match Cil.constFoldToInt e with
- | Some i64 -> Some (Integer.to_int i64)
+ | Some n -> (try Some (Integer.to_int n) with Z.Overflow -> None)
| _ -> None
end
| _ -> None
diff --git a/src/kernel_internals/typing/mergecil.ml b/src/kernel_internals/typing/mergecil.ml
index ee71ac69171e329cc7e51a9b69af4861bf6a5abe..ca79f462689c63e88545120c93298b450e7f1507 100644
--- a/src/kernel_internals/typing/mergecil.ml
+++ b/src/kernel_internals/typing/mergecil.ml
@@ -461,16 +461,21 @@ module ExtMerging =
Merging
(struct
type t = acsl_extension
- let hash (_,name,_,kind) =
+ let hash ((_,name,_,_,kind) : acsl_extension) =
Datatype.String.hash name + 5 * hash_ext_kind kind
- let compare (_,name1, _,kind1) (_,name2,_,kind2) =
+ let compare
+ ((_,name1,_,s1,kind1) : acsl_extension)
+ ((_,name2,_,s2,kind2) : acsl_extension) =
let res = Datatype.String.compare name1 name2 in
if res <> 0 then res
else
- compare_ext_kind kind1 kind2
+ let res = Datatype.Bool.compare s1 s2 in
+ if res <> 0 then res
+ else
+ compare_ext_kind kind1 kind2
let equal x y = compare x y = 0
let merge_synonym _ = true
- let output fmt (_,name,_,_) =
+ let output fmt (_,name,_,_,_) =
Format.fprintf fmt "global ACSL extension %s" name
end)
diff --git a/src/kernel_services/abstract_interp/abstract_interp.ml b/src/kernel_services/abstract_interp/abstract_interp.ml
index 31bdbd7a92432988a8e4002ce562aa327740cd50..3d2f1fdd6bff8e142fb2dcfdea076c3b91522f73 100644
--- a/src/kernel_services/abstract_interp/abstract_interp.ml
+++ b/src/kernel_services/abstract_interp/abstract_interp.ml
@@ -390,7 +390,7 @@ module Int = struct
let fold f ~inf ~sup ~step acc =
(* Format.printf "Int.fold: inf:%a sup:%a step:%a@\n"
pretty inf pretty sup pretty step; *)
- let nb_loop = div (sub sup inf) step in
+ let nb_loop = e_div (sub sup inf) step in
let rec fold_incr ~counter ~inf acc =
if equal counter onethousand then
Lattice_messages.emit_costly msg_emitter
diff --git a/src/kernel_services/abstract_interp/abstract_interp.mli b/src/kernel_services/abstract_interp/abstract_interp.mli
index 140949d5b2561e5ff91009bf111cbcc86a25b54d..7a666ccfe69b91161c6523f4c6b9acb78ca60fc2 100644
--- a/src/kernel_services/abstract_interp/abstract_interp.mli
+++ b/src/kernel_services/abstract_interp/abstract_interp.mli
@@ -87,7 +87,7 @@ module Rel : sig
val add_abs : Int.t -> t -> Int.t
val add : t -> t -> t
val sub_abs : Int.t -> Int.t -> t
- val pos_rem: t -> Int.t -> t
+ val e_rem: t -> Int.t -> t
val check: rem:t -> modu:Int.t -> bool
end
diff --git a/src/kernel_services/abstract_interp/base.ml b/src/kernel_services/abstract_interp/base.ml
index 87254965dd6ab4feac9e7fcfffa6109a7ab4d2eb..4ee29fa9fdc7440f4ed9f783221d95111a001677 100644
--- a/src/kernel_services/abstract_interp/base.ml
+++ b/src/kernel_services/abstract_interp/base.ml
@@ -205,7 +205,8 @@ let () =
(mul_CHAR_BIT (Int.of_string min));
MaxValidAbsoluteAddress.set
((Int.pred (mul_CHAR_BIT (Int.succ (Int.of_string max))))))
- with End_of_file | Scanf.Scan_failure _ | Failure _ as e ->
+ with End_of_file | Scanf.Scan_failure _ | Failure _
+ | Invalid_argument _ as e ->
Kernel.abort "Invalid -absolute-valid-range integer-integer: each integer may be in decimal, hexadecimal (0x, 0X), octal (0o) or binary (0b) notation and has to hold in 64 bits. A correct example is -absolute-valid-range 1-0xFFFFFF0.@\nError was %S@."
(Printexc.to_string e))
@@ -291,9 +292,9 @@ let is_aligned_by b alignment =
else
match b with
| Var (v,_) | Allocated(v,_,_) ->
- Int.is_zero (Int.rem (Int.of_int (Cil.bytesAlignOf v.vtype)) alignment)
+ Int.is_zero (Int.e_rem (Int.of_int (Cil.bytesAlignOf v.vtype)) alignment)
| CLogic_Var (_, ty, _) ->
- Int.is_zero (Int.rem (Int.of_int (Cil.bytesAlignOf ty)) alignment)
+ Int.is_zero (Int.e_rem (Int.of_int (Cil.bytesAlignOf ty)) alignment)
| Null -> true
| String _ -> Int.is_one alignment
diff --git a/src/kernel_services/abstract_interp/ival.ml b/src/kernel_services/abstract_interp/ival.ml
index ce2e6ad7ca77b84a1848fc74c0a9dcb318db2f4a..eb88284cee5c2e28b1f0e347c0cbfc3208430d4d 100644
--- a/src/kernel_services/abstract_interp/ival.ml
+++ b/src/kernel_services/abstract_interp/ival.ml
@@ -230,7 +230,7 @@ let is_safe_modulo r modu =
let is_safe_bound bound r modu = match bound with
| None -> true
- | Some m -> Int.equal (Int.pos_rem m modu) r
+ | Some m -> Int.equal (Int.e_rem m modu) r
(* Sanity check for Top's arguments *)
let check min max r modu =
@@ -328,7 +328,7 @@ let project_float v =
| Top _ | Set _ -> assert false (* by hypothesis that it is a float *)
let in_interval x min max r modu =
- Int.equal (Int.pos_rem x modu) r && min_le_elt min x && max_ge_elt max x
+ Int.equal (Int.e_rem x modu) r && min_le_elt min x && max_ge_elt max x
let array_mem v a =
let l = Array.length a in
@@ -367,7 +367,7 @@ let cardinal v =
match v with
| Top (None,_,_,_) | Top (_,None,_,_) -> None
| Top (Some mn, Some mx,_,m) ->
- Some (Int.succ ((Int.native_div (Int.sub mx mn) m)))
+ Some (Int.succ ((Int.e_div (Int.sub mx mn) m)))
| Set s -> Some (Int.of_int (Array.length s))
| Float f -> if Fval.is_singleton f then Some Int.one else None
@@ -376,7 +376,7 @@ let cardinal_estimate v ~size =
| Set s -> Int.of_int (Array.length s)
| Top (None, _, _, _)
| Top (_, None, _, _) -> Int.two_power size
- | Top (Some mn, Some mx, _, d) -> Int.(succ (div (sub mx mn) d))
+ | Top (Some mn, Some mx, _, d) -> Int.(succ (e_div (sub mx mn) d))
| Float f ->
if Fval.is_singleton f
then Int.one
@@ -397,7 +397,7 @@ let cardinal_less_than v n =
match v with
| Top (None,_,_,_) | Top (_,None,_,_) -> raise Not_less_than
| Top (Some mn, Some mx,_,m) ->
- Int.succ ((Int.native_div (Int.sub mx mn) m))
+ Int.succ ((Int.e_div (Int.sub mx mn) m))
| Set s -> Int.of_int (Array.length s)
| Float f ->
if Fval.is_singleton f then Int.one else raise Not_less_than
@@ -419,7 +419,7 @@ let make ~min ~max ~rem ~modu =
match min, max with
| Some mn, Some mx ->
if Int.gt mx mn then
- let l = Int.succ (Int.div (Int.sub mx mn) modu) in
+ let l = Int.succ (Int.e_div (Int.sub mx mn) modu) in
if Int.le l !small_cardinal_Int
then
let l = Int.to_int l in
@@ -449,7 +449,7 @@ let inject_interval ~min ~max ~rem:r ~modu =
assert (is_safe_modulo r modu);
let fix_bound fix bound = match bound with
| None -> None
- | Some b -> Some (if Int.equal b (Int.pos_rem r modu) then b else fix b)
+ | Some b -> Some (if Int.equal b (Int.e_rem r modu) then b else fix b)
in
let min = fix_bound (fun min -> Int.round_up_to_r ~min ~r ~modu) min
and max = fix_bound (fun max -> Int.round_down_to_r ~max ~r ~modu) max in
@@ -470,7 +470,7 @@ let subdiv_int v =
share_array lo m,
share_array hi lenhi
| Top (Some lo, Some hi, rem, modu) ->
- let mean = Int.native_div (Int.add lo hi) Int.two in
+ let mean = Int.e_div (Int.add lo hi) Int.two in
let succmean = Int.succ mean in
inject_interval ~min:(Some lo) ~max:(Some mean) ~rem ~modu,
inject_interval ~min:(Some succmean) ~max:(Some hi) ~rem ~modu
@@ -503,7 +503,7 @@ let unsafe_make_top_from_set_4 s =
s
Int.zero
in
- let r = Int.pos_rem m modu in
+ let r = Int.e_rem m modu in
let max = O.max_elt s in
let min = m in
(min,max,r,modu)
@@ -521,7 +521,7 @@ let unsafe_make_top_from_array_4 s =
Int.zero
s
in
- let r = Int.pos_rem m modu in
+ let r = Int.e_rem m modu in
let max = Some s.(pred l) in
let min = Some m in
check min max r modu;
@@ -565,7 +565,7 @@ let inject_ps ps =
match ps with
Pre_set(o, s) -> share_set o s
| Pre_top (min, max, modu) ->
- Top(Some min, Some max, Int.pos_rem min modu, modu)
+ Top(Some min, Some max, Int.e_rem min modu, modu)
let min_max_r_mod t =
match t with
@@ -648,7 +648,7 @@ let widen (bitsize,wh) t1 t2 =
let (mn2,mx2,r2,m2) = min_max_r_mod t2 in
let (mn1,mx1,r1,m1) = min_max_r_mod t1 in
let new_mod = Int.pgcd (Int.pgcd m1 m2) (Int.abs (Int.sub r1 r2)) in
- let new_rem = Int.rem r1 new_mod in
+ let new_rem = Int.e_rem r1 new_mod in
let new_min = if bound_compare mn1 mn2 = 0 then mn2 else
match mn2 with
| None -> None
@@ -717,7 +717,7 @@ let extended_euclidian_algorithm a b =
let x = ref Int.zero and lastx = ref Int.one in
let y = ref Int.one and lasty = ref Int.zero in
while not (Int.is_zero !b) do
- let (q,r) = Int.div_rem !a !b in
+ let (q,r) = Int.e_div_rem !a !b in
a := !b;
b := r;
let tmpx = !x in
@@ -746,27 +746,27 @@ let compute_r_common r1 m1 r2 m2 =
<=> \E k1,k2: x = r1 + k1*m1 && x = r2 + k2*m2
<=> \E k1,k2: x = r1 + k1*m1 && k1*m1 - k2*m2 = r2 - r1
- Let c = r2 - r1. The equation (E2): k1*m1 - k2*m2 = c is
+ Let r = r2 - r1. The equation (E2): k1*m1 - k2*m2 = r is
diophantine; there are solutions x to (E1) iff there are
solutions (k1,k2) to (E2).
Let d = pgcd(m1,m2). There are solutions to (E2) only if d
- divides c (because d divides k1*m1 - k2*m2). Else we raise
+ divides r (because d divides k1*m1 - k2*m2). Else we raise
[Error_Bottom]. *)
let (x1,_,pgcd) = extended_euclidian_algorithm m1 m2 in
- let c = Int.sub r2 r1 in
- let (c_div_d,c_rem) = Int.div_rem c pgcd in
- if not (Int.equal c_rem Int.zero)
+ let r = Int.sub r2 r1 in
+ let r_div,r_rem = Int.e_div_rem r pgcd in
+ if not (Int.equal r_rem Int.zero)
then raise Error_Bottom
(* The extended euclidian algorithm has provided solutions x1,x2 to
the Bezout identity x1*m1 + x2*m2 = d.
- x1*m1 + x2*m2 = d ==> x1*(c/d)*m1 + x2*(c/d)*m2 = d*(c/d).
+ x1*m1 + x2*m2 = d ==> x1*(r/d)*m1 + x2*(r/d)*m2 = d*(r/d).
- Thus, k1 = x1*(c/d), k2=-x2*(c/d) are solutions to (E2)
- Thus, x = r1 + x1*(c/d)*m1 is a particular solution to (E1). *)
- else let k1 = Int.mul x1 c_div_d in
+ Thus, k1 = x1*(r/d), k2=-x2*(r/d) are solutions to (E2)
+ Thus, x = r1 + x1*(r/d)*m1 is a particular solution to (E1). *)
+ else let k1 = Int.mul x1 r_div in
let x = Int.add r1 (Int.mul k1 m1) in
(* If two solutions x and y exist, they are equal modulo ppcm(m1,m2).
@@ -777,7 +777,7 @@ let compute_r_common r1 m1 r2 m2 =
of ppcm(m1,m2). Thus x = y mod ppcm(m1,m2). *)
let ppcm = Integer.ppcm m1 m2 in
(* x may be bigger than the ppcm, we normalize it. *)
- (Int.rem x ppcm, ppcm)
+ (Int.e_rem x ppcm, ppcm)
;;
let array_truncate r i =
@@ -1021,7 +1021,7 @@ let join v1 v2 =
check mn1 mx1 r1 m1;
check mn2 mx2 r2 m2;
let modu = Int.pgcd (Int.pgcd m1 m2) (Int.abs(Int.sub r1 r2)) in
- let r = Int.rem r1 modu in
+ let r = Int.e_rem r1 modu in
let min = min_min mn1 mn2 in
let max = max_max mx1 mx2 in
let r = inject_top min max r modu in
@@ -1033,7 +1033,7 @@ let join v1 v2 =
else
let f modu elt = Int.pgcd modu (Int.abs(Int.sub r elt)) in
let new_modu = Array.fold_left f modu s in
- let new_r = Int.rem r new_modu in
+ let new_r = Int.e_rem r new_modu in
let new_min = match min with
None -> None
| Some m -> Some (Int.min m s.(0))
@@ -1194,7 +1194,7 @@ let max_is_greater mx1 mx2 =
Int.ge m1 m2
let rem_is_included r1 m1 r2 m2 =
- (Int.is_zero (Int.rem m1 m2)) && (Int.equal (Int.rem r1 m2) r2)
+ (Int.is_zero (Int.e_rem m1 m2)) && (Int.equal (Int.e_rem r1 m2) r2)
let array_for_all f (a : Integer.t array) =
let l = Array.length a in
@@ -1238,7 +1238,7 @@ let is_included t1 t2 =
(* Inclusion of bounds is needed for the entire inclusion *)
min_le_elt min s.(0) && max_ge_elt max s.(Array.length s-1)
&& (Int.equal Int.one modu || (*Top side contains all integers, we're done*)
- array_for_all (fun x -> Int.equal (Int.pos_rem x modu) r) s)
+ array_for_all (fun x -> Int.equal (Int.e_rem x modu) r) s)
| Set s1, Set s2 -> array_subset s1 s2
| Float f1, Float f2 -> Fval.is_included f1 f2
| Float _, _ -> equal t2 top
@@ -1385,7 +1385,7 @@ let add_singleton_int i v = match v with
let incr v = Int.add i v in
let new_mn = opt1 incr mn in
let new_mx = opt1 incr mx in
- let new_r = Int.pos_rem (incr r) m in
+ let new_r = Int.e_rem (incr r) m in
share_top new_mn new_mx new_r m
@@ -1398,7 +1398,7 @@ let rec add_int v1 v2 =
apply2_n Int.add s1 s2
| Top(mn1,mx1,r1,m1), Top(mn2,mx2,r2,m2) ->
let m = Int.pgcd m1 m2 in
- let r = Int.rem (Int.add r1 r2) m in
+ let r = Int.e_rem (Int.add r1 r2) m in
let mn =
try
Some (Int.round_up_to_r (opt2 Int.add mn1 mn2) r m)
@@ -1435,7 +1435,7 @@ let add_int_under v1 v2 = match v1,v2 with
when Int.equal modu1 modu2 ->
(* Note: min1+min2 % modu = max1 + max2 % modu = r1 + r2 % modu;
no need to trim the bounds here. *)
- let r = Int.rem (Int.add r1 r2) modu1 in
+ let r = Int.e_rem (Int.add r1 r2) modu1 in
let min = match min1, min2 with
| Some min1, Some min2 -> Some (Int.add min1 min2)
| _ -> None in
@@ -1473,7 +1473,7 @@ let neg_int v =
share_top
(opt1 Int.neg mx)
(opt1 Int.neg mn)
- (Int.pos_rem (Int.neg r) m)
+ (Int.e_rem (Int.neg r) m)
m
let sub_int v1 v2 = add_int v1 (neg_int v2)
@@ -1544,12 +1544,12 @@ let scale f v =
let modu = incr m1 in
share_top
(opt1 incr mn1) (opt1 incr mx1)
- (Int.pos_rem (incr r1) modu) modu
+ (Int.e_rem (incr r1) modu) modu
else
let modu = Int.neg (incr m1) in
share_top
(opt1 incr mx1) (opt1 incr mn1)
- (Int.pos_rem (incr r1) modu) modu
+ (Int.e_rem (incr r1) modu) modu
| Set s ->
if Int.ge f Int.zero
then apply_bin_1_strict_incr Int.mul f s
@@ -1561,7 +1561,7 @@ let scale_div_common ~pos f v degenerate_ival degenerate_float =
assert (not (Int.is_zero f));
let div_f =
if pos
- then fun a -> Int.pos_div a f
+ then fun a -> Int.e_div a f
else fun a -> Int.c_div a f
in
match v with
@@ -1571,12 +1571,12 @@ let scale_div_common ~pos f v degenerate_ival degenerate_float =
if (negative (* all negative *) ||
pos (* good div *) ||
(min_is_lower (some_zero) mn1) (* all positive *) ||
- (Int.is_zero (Int.rem r1 f)) (* exact *) )
- && (Int.is_zero (Int.rem m1 f))
+ (Int.is_zero (Int.e_rem r1 f)) (* exact *) )
+ && (Int.is_zero (Int.e_rem m1 f))
then
let modu = Int.abs (div_f m1) in
let r = if negative then Int.sub r1 m1 else r1 in
- (Int.pos_rem (div_f r) modu), modu
+ (Int.e_rem (div_f r) modu), modu
else (* degeneration*)
degenerate_ival r1 m1
in
@@ -1681,7 +1681,7 @@ let div x y =
elements [x mod f] for [x] in [v].
[scale_rem ~pos:true f v] is an over-approximation of the set of
- elements [x pos_rem f] for [x] in [v].
+ elements [x e_rem f] for [x] in [v].
*)
let scale_rem ~pos f v =
(* Format.printf "scale_rem %b %a %a@."
@@ -1692,12 +1692,12 @@ let scale_rem ~pos f v =
else
let f = if Int.lt f Int.zero then Int.neg f else f in
let rem_f a =
- if pos then Int.pos_rem a f else Int.c_rem a f
+ if pos then Int.e_rem a f else Int.c_rem a f
in
match v with
| Top(mn,mx,r,m) ->
let modu = Int.pgcd f m in
- let rr = Int.pos_rem r modu in
+ let rr = Int.e_rem r modu in
let binf,bsup =
if pos
then (Int.round_up_to_r ~min:Int.zero ~r:rr ~modu),
@@ -1716,7 +1716,7 @@ let scale_rem ~pos f v =
match mn,mx with
| Some mn,Some mx ->
let div_f a =
- if pos then Int.pos_div a f else Int.c_div a f
+ if pos then Int.e_div a f else Int.c_div a f
in
(* See if [mn..mx] is included in [k*f..(k+1)*f] for some [k]. In
this case, [%] is monotonic and [mn%f .. mx%f] is a more precise
@@ -1833,7 +1833,7 @@ let cast_int_to_int ~size ~signed value =
let not_p_factor = Int.neg factor in
let best_effort r m =
let modu = Int.pgcd factor m in
- let rr = Int.pos_rem r modu in
+ let rr = Int.e_rem r modu in
let min_val = Some (if signed then
Int.round_up_to_r ~min:(Int.neg mask) ~r:rr ~modu
else
@@ -1863,7 +1863,7 @@ let cast_int_to_int ~size ~signed value =
then value
else
let new_min = rem_f mn in
- let new_r = Int.pos_rem new_min m in
+ let new_r = Int.e_rem new_min m in
inject_top (Some new_min) (Some (rem_f mx)) new_r m
else best_effort r m
| Top (_,_,r,m) ->
@@ -1957,7 +1957,7 @@ let rec mul v1 v2 =
let modu = Int.ppcm modu1 modu2 in *)
let modu = Int.(pgcd (pgcd (mul m1 m2) (mul r1 m2)) (mul r2 m1))
in
- let r = Int.rem (Int.mul r1 r2) modu in
+ let r = Int.e_rem (Int.mul r1 r2) modu in
(* let t = Top (ext_proj min, ext_proj max, r, modu) in
Format.printf "mul. Result: '%a'@\n" pretty t; *)
inject_top (ext_proj min) (ext_proj max) r modu
@@ -1988,7 +1988,7 @@ let shift_aux scale op (x: t) (y: t) =
let modu = match min_factor with None -> Int.one | Some m -> m in
let factor = inject_top min_factor max_factor Int.zero modu in
op x factor
- with Integer.Too_big ->
+ with Z.Overflow ->
Lattice_messages.emit_imprecision emitter "Ival.shift_aux";
(* We only preserve the sign of the result *)
if is_included x positive_integers then positive_integers
@@ -2017,7 +2017,7 @@ module Infty = struct
| None -> None
| Some a -> match b with
| None -> Some Int.zero
- | Some b -> Some (Int.div a b)
+ | Some b -> Some (Int.e_div a b)
let neg = function
| Some a -> Some (Int.neg a)
@@ -2199,7 +2199,7 @@ let rec extract_bits ~start ~stop ~size v =
try
let dived = scale_div ~pos:true (Int.two_power start) d in
scale_rem ~pos:true (Int.two_power (Int.length start stop)) dived
- with Integer.Too_big ->
+ with Z.Overflow ->
Lattice_messages.emit_imprecision emitter "Ival.extract_bits";
top
;;
@@ -2428,7 +2428,7 @@ let cast_int_to_float_inverse_not_nan ~single_precision (min, max) =
values on each extremity. *)
let min = ceil min in
let max = floor max in
- let conv f = try Some (Integer.of_float f) with Integer.Too_big -> None in
+ let conv f = try Some (Integer.of_float f) with Z.Overflow -> None in
let r = inject_range (conv min) (conv max) in
(* Kernel.result "Cast I->F inv: %a -> %a@." pretty f pretty r; *)
r
diff --git a/src/kernel_services/abstract_interp/ival.mli b/src/kernel_services/abstract_interp/ival.mli
index b4f3e5a485b8c26e3936e919e65ade6a44346eef..32218fd774658eb5f127b9d0603a205fd1b8153e 100644
--- a/src/kernel_services/abstract_interp/ival.mli
+++ b/src/kernel_services/abstract_interp/ival.mli
@@ -237,25 +237,25 @@ val scale : Integer.t -> t -> t
val scale_div : pos:bool -> Integer.t -> t -> t
(** [scale_div ~pos:false f v] is an over-approximation of the set of
- elements [x / f] for [x] in [v].
+ elements [x c_div f] for [x] in [v].
[scale_div ~pos:true f v] is an over-approximation of the set of
- elements [x pos_div f] for [x] in [v]. *)
+ elements [x e_div f] for [x] in [v]. *)
val scale_div_under : pos:bool -> Integer.t -> t -> t
(** [scale_div_under ~pos:false f v] is an under-approximation of the
- set of elements [x / f] for [x] in [v].
+ set of elements [x c_div f] for [x] in [v].
[scale_div_under ~pos:true f v] is an under-approximation of the
- set of elements [x pos_div f] for [x] in [v]. *)
+ set of elements [x e_div f] for [x] in [v]. *)
val div : t -> t -> t (** Integer division *)
val scale_rem : pos:bool -> Integer.t -> t -> t
(** [scale_rem ~pos:false f v] is an over-approximation of the set of
- elements [x mod f] for [x] in [v].
+ elements [x c_rem f] for [x] in [v].
[scale_rem ~pos:true f v] is an over-approximation of the set of
- elements [x pos_rem f] for [x] in [v]. *)
+ elements [x e_rem f] for [x] in [v]. *)
val c_rem : t -> t -> t
val mul : t -> t -> t
diff --git a/src/kernel_services/abstract_interp/offsetmap.ml b/src/kernel_services/abstract_interp/offsetmap.ml
index 65b75830d44797231236f36c18da41f0e86135f4..01dba5d8ede8bb1189928451d76109ba3d3f0bfb 100644
--- a/src/kernel_services/abstract_interp/offsetmap.ml
+++ b/src/kernel_services/abstract_interp/offsetmap.ml
@@ -33,8 +33,8 @@ let ( >=~ ) = Integer.ge
let ( +~ ) = Integer.add
let ( -~ ) = Integer.sub
(* let ( *~ ) = Integer.mul *)
-let ( /~ ) = Integer.pos_div
-let ( %~ ) = Integer.pos_rem
+let ( /~ ) = Integer.e_div
+let ( %~ ) = Integer.e_rem
let succ = Integer.succ
let pred = Integer.pred
@@ -90,7 +90,7 @@ type 'a offsetmap =
alignment must be recomputed wrt the offset of the new interval. The new
alignment should be consistent with the size of the value. *)
let realign ~offset ~new_offset rem modu =
- Rel.pos_rem (Rel.add (Rel.sub_abs offset new_offset) rem) modu
+ Rel.e_rem (Rel.add (Rel.sub_abs offset new_offset) rem) modu
(** plevel-related operation: value + hooks to call when the value is modified*)
let plevel = ref 200
@@ -1007,7 +1007,7 @@ module Make (V : module type of Offsetmap_lattice_with_isotropy) = struct
else
begin (* abs_max1 >~ abs_max2 *)
let min = succ abs_max2 in
- let rem1 = Rel.pos_rem (Rel.add (Rel.sub_abs o1 min) rem1) modu1 in
+ let rem1 = Rel.e_rem (Rel.add (Rel.sub_abs o1 min) rem1) modu1 in
let new_offr1, new_subr1 =
add_node ~min ~max:abs_max1 rem1 modu1 v1 abs_offr1 subr1
in
@@ -1978,7 +1978,7 @@ let update_under ~validity ~exact ~offsets ~size v t =
let lmin = Integer.max imin curr_off in
let lmax = Integer.min imax abs_max in
let lrem =
- Rel.pos_rem (Rel.sub rem (Rel.sub_abs lmin curr_off)) modu
+ Rel.e_rem (Rel.sub rem (Rel.sub_abs lmin curr_off)) modu
in
f (lmin, lmax) (v, modu, lrem) acc
in
@@ -2123,7 +2123,7 @@ let update_under ~validity ~exact ~offsets ~size v t =
(if Int.length bk ek >~ modu then
Format.fprintf fmt " repeated %%%a " pretty_int modu)
else (
- let b_bits = Rel.pos_rem (Rel.sub Rel.zero rel_offs) modu in
+ let b_bits = Rel.e_rem (Rel.sub Rel.zero rel_offs) modu in
let e_bits = Rel.add_abs (ek -~ bk) b_bits in
Format.fprintf fmt "%s%%%a, bits %a to %a "
(if e_bits >~ modu then " repeated " else "")
diff --git a/src/kernel_services/analysis/bit_utils.ml b/src/kernel_services/analysis/bit_utils.ml
index 136e76937003d473afea011ffa5282634c8f44a6..138752a80602f4d4a52fcc9729608b281de5d4a5 100644
--- a/src/kernel_services/analysis/bit_utils.ml
+++ b/src/kernel_services/analysis/bit_utils.ml
@@ -191,7 +191,7 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
let raw_bits c start stop =
let cond =
env.use_align
- && ((not (Integer.equal (Integer.pos_rem start env.rh_size) align))
+ && ((not (Integer.equal (Integer.e_rem start env.rh_size) align))
|| (not (Integer.equal req_size env.rh_size)))
in
Format.fprintf env.fmt "[%s%t]%s"
@@ -272,7 +272,7 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
| Some i -> Bitfield (Integer.to_int64 (Integer.of_int i))
in
let new_align =
- Integer.pos_rem (Integer.sub align start_o) env.rh_size
+ Integer.e_rem (Integer.sub align start_o) env.rh_size
in
let name = Format.asprintf "%a" Printer.pp_field field in
NamedField( name ,
@@ -348,13 +348,11 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
if Integer.is_zero size then
raw_bits 'z' start stop
else
- let start_case = Integer.pos_div start size in
- let stop_case = Integer.pos_div stop size in
- let rem_start_size = Integer.pos_rem start size in
- let rem_stop_size = Integer.pos_rem stop size in
+ let start_case,rem_start_size = Integer.e_div_rem start size in
+ let stop_case,rem_stop_size = Integer.e_div_rem stop size in
if Integer.equal start_case stop_case then (** part of one element *)
let new_align =
- Integer.pos_rem
+ Integer.e_rem
(Integer.sub align (Integer.mul start_case size))
env.rh_size
in
@@ -363,8 +361,8 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
~align:new_align
~start:rem_start_size
~stop:rem_stop_size
- else if Integer.equal (Integer.rem start env.rh_size) align
- && (Integer.is_zero (Integer.rem size env.rh_size))
+ else if Integer.equal (Integer.e_rem start env.rh_size) align
+ && (Integer.is_zero (Integer.e_rem size env.rh_size))
then
let pred_size = Integer.pred size in
let start_full_case =
@@ -427,7 +425,7 @@ let pretty_bits typ ~use_align ~align ~rh_size ~start ~stop fmt =
Cil easily gives offset information in terms of offset since the start,
but not easily the offset between two fields (with padding) *)
let align =
- Integer.pos_rem (Abstract_interp.Rel.add_abs start align) rh_size
+ Integer.e_rem (Abstract_interp.Rel.add_abs start align) rh_size
in
assert (Integer.le Integer.zero align
&& Integer.lt align rh_size);
@@ -533,9 +531,9 @@ let rec find_offset typ ~offset om =
Index (minus_one_expr, NoOffset), typ
end
else
- let start = Integer.pos_div offset size_elt in
+ let start = Integer.e_div offset size_elt in
let exp_start = Cil.kinteger64 ~loc start in
- let rem = Integer.pos_rem offset size_elt in
+ let rem = Integer.e_rem offset size_elt in
if offset_match_cell om size_elt then
(* [size] covers at most one cell; we continue in the relevant one *)
let off, typ = find_offset typ_elt rem om in
@@ -545,10 +543,10 @@ let rec find_offset typ ~offset om =
| MatchFirst | MatchType _ -> raise NoMatchingOffset
| MatchSize size ->
if Integer.is_zero rem
- && Integer.is_zero (Integer.rem size size_elt)
+ && Integer.is_zero (Integer.e_rem size size_elt)
then
(* We cover more than one cell, but we are aligned. *)
- let nb = Integer.div size size_elt in
+ let nb = Integer.e_div size size_elt in
let exp_nb = Cil.kinteger64 ~loc nb in
let typ =
TArray (typ_elt, Some exp_nb, Cil.empty_size_cache (),[])
diff --git a/src/kernel_services/ast_data/cil_types.mli b/src/kernel_services/ast_data/cil_types.mli
index d9acbb6b3b8891732a8607cce573208df9d8b005..c550806aaab96422e193ca33ed092fe8e4fca01e 100644
--- a/src/kernel_services/ast_data/cil_types.mli
+++ b/src/kernel_services/ast_data/cil_types.mli
@@ -1646,6 +1646,11 @@ and spec = {
(** Extension to standard ACSL clause with an unique identifier.
+
+ The integer is a (unique) identifier.
+ The boolean flag is [true] if the annotation can be assigned a
+ property status.
+
Use {!Logic_const.new_acsl_extension} to create new acsl extension with
a fresh id.
Each extension is associated with a keyword, and can be either a global
@@ -1664,7 +1669,7 @@ and spec = {
grammar ambiguous.
@plugin development guide *)
-and acsl_extension = int * string * location * acsl_extension_kind
+and acsl_extension = int * string * location * bool * acsl_extension_kind
(** @plugin development guide *)
and acsl_extension_kind =
diff --git a/src/kernel_services/ast_data/property.ml b/src/kernel_services/ast_data/property.ml
index 233e4c4162cc2af8bc76e1bd0e600d2958777741..d61e7eec939bc5495e058724901f21d606f8bf2e 100644
--- a/src/kernel_services/ast_data/property.ml
+++ b/src/kernel_services/ast_data/property.ml
@@ -20,6 +20,10 @@
(* *)
(**************************************************************************)
+(* -------------------------------------------------------------------------- *)
+(* --- Property Type --- *)
+(* -------------------------------------------------------------------------- *)
+
open Cil_types
open Cil_datatype
@@ -145,6 +149,10 @@ and identified_property =
| IPGlobalInvariant of identified_global_invariant
| IPOther of string * other_loc
+(* -------------------------------------------------------------------------- *)
+(* --- Getters --- *)
+(* -------------------------------------------------------------------------- *)
+
let ki_of_e_loc = function
| ELContract _ | ELGlob -> Kglobal
| ELStmt (_,s) -> Kstmt s
@@ -246,7 +254,7 @@ let rec location = function
| [] -> Cil_datatype.Location.unknown
| p :: _ -> location p)
| IPLemma (_,_,_,_,loc) -> loc
- | IPExtended(_,(_,_,loc,_)) -> loc
+ | IPExtended(_,(_,_,loc,_,_)) -> loc
| IPOther(_,loc_e) -> loc_of_loc_o loc_e
| IPTypeInvariant(_,_,_,loc) | IPGlobalInvariant(_,_,loc) -> loc
@@ -291,6 +299,40 @@ let get_behavior = function
| IPGlobalInvariant _
| IPOther _ -> None
+(* -------------------------------------------------------------------------- *)
+(* --- Property Status --- *)
+(* -------------------------------------------------------------------------- *)
+
+let has_status_ext ((_,_,_,status,_) : Cil_types.acsl_extension) = status
+
+let has_status_ca = function
+ | AAssert _ | AStmtSpec _ | AInvariant _ | AVariant _ | AAllocation _
+ | AAssigns _ -> true
+ | AExtended(_,_,e) -> has_status_ext e
+ | APragma _ -> false
+
+let has_status_pkind = function
+ | PKAssumes _ -> false
+ | PKEnsures _ | PKRequires _ | PKTerminates
+ -> true
+
+let rec has_status = function
+ | IPPredicate(pkind, _, _, _) -> has_status_pkind pkind
+ | IPExtended(_,e) -> has_status_ext e
+ | IPCodeAnnot(_,_, { annot_content = ca }) -> has_status_ca ca
+ | IPPropertyInstance(_,_,_,ip) -> has_status ip
+ | IPOther _ | IPReachable _
+ | IPAxiom _ | IPAxiomatic _ | IPBehavior _
+ | IPDisjoint _ | IPComplete _
+ | IPAssigns _ | IPFrom _
+ | IPAllocation _ | IPDecrease _ | IPLemma _
+ | IPTypeInvariant _ | IPGlobalInvariant _
+ -> true
+
+(* -------------------------------------------------------------------------- *)
+(* --- Datatype --- *)
+(* -------------------------------------------------------------------------- *)
+
include Datatype.Make_with_collections
(struct
@@ -413,7 +455,7 @@ include Datatype.Make_with_collections
| IPOther(s,_) -> Hashtbl.hash (15, (s:string))
| IPTypeInvariant(s,_,_,_) -> Hashtbl.hash (16, (s:string))
| IPGlobalInvariant(s,_,_) -> Hashtbl.hash (17, (s:string))
- | IPExtended (_,(i,_,_,_)) -> Hashtbl.hash (18, i)
+ | IPExtended (_,(i,_,_,_,_)) -> Hashtbl.hash (18, i)
let rec equal p1 p2 =
let eq_bhv (f1,ki1,b1) (f2,ki2,b2) =
@@ -430,7 +472,7 @@ include Datatype.Make_with_collections
in
match p1, p2 with
| IPPredicate (_,_,_,s1), IPPredicate (_,_,_,s2) -> s1.ip_id = s2.ip_id
- | IPExtended (_,(i1,_,_,_)), IPExtended (_,(i2,_,_,_)) -> Datatype.Int.equal i1 i2
+ | IPExtended (_,(i1,_,_,_,_)), IPExtended (_,(i2,_,_,_,_)) -> Datatype.Int.equal i1 i2
| IPAxiom (s1,_,_,_,_), IPAxiom (s2,_,_,_,_)
| IPAxiomatic(s1, _), IPAxiomatic(s2, _)
| IPTypeInvariant(s1,_,_,_), IPTypeInvariant(s2,_,_,_)
@@ -490,7 +532,7 @@ include Datatype.Make_with_collections
match x, y with
| IPPredicate (_,_,_,s1), IPPredicate (_,_,_,s2) ->
Datatype.Int.compare s1.ip_id s2.ip_id
- | IPExtended (_,(i1,_,_,_)), IPExtended (_,(i2,_,_,_)) ->
+ | IPExtended (_,(i1,_,_,_,_)), IPExtended (_,(i2,_,_,_,_)) ->
Datatype.Int.compare i1 i2
| IPCodeAnnot(_,_,ca1), IPCodeAnnot(_,_,ca2) ->
Datatype.Int.compare ca1.annot_id ca2.annot_id
@@ -572,7 +614,7 @@ let rec short_pretty fmt p = match p with
| IPPredicate (_,_,_,{ ip_content = {pred_name = name :: _ }}) ->
Format.pp_print_string fmt name
| IPPredicate _ -> pretty fmt p
- | IPExtended (_,(_,name,_,_)) -> Format.pp_print_string fmt name
+ | IPExtended (_,(_,name,_,_,_)) -> Format.pp_print_string fmt name
| IPAxiom (name,_,_,_,_) | IPLemma(name,_,_,_,_)
| IPTypeInvariant(name,_,_,_) -> Format.pp_print_string fmt name
| IPGlobalInvariant(name,_,_) -> Format.pp_print_string fmt name
@@ -861,7 +903,7 @@ struct
Format.asprintf "%s%s%a"
(kf_prefix kf) (predicate_kind_txt pk ki)
pp_names idp.ip_content.pred_name
- | IPExtended (le,(_,name,_,_)) ->
+ | IPExtended (le,(_,name,_,_,_)) ->
Format.asprintf "%sextended%a" (extended_loc_prefix le) pp_names [name]
| IPCodeAnnot (kf,_, ca) ->
let name = match ca.annot_content with
@@ -869,7 +911,11 @@ struct
| AInvariant (_,true,_) -> "loop_inv"
| AInvariant _ -> "inv"
| APragma _ -> "pragma"
- | _ -> assert false
+ | AStmtSpec _ -> "contract"
+ | AAssigns _ -> "assigns"
+ | AVariant _ -> "variant"
+ | AAllocation _ -> "allocates"
+ | AExtended(_,_,(_,clause,_,_,_)) -> clause
in Format.asprintf "%s%s%a" (kf_prefix kf) name pp_code_annot_names ca
| IPComplete (kf, ki, a, lb) ->
Format.asprintf "%s%s%acomplete%a"
@@ -1045,7 +1091,7 @@ struct
| IPCodeAnnot (kf,stmt, { annot_content = APragma _ } ) ->
[ K kf ; A "pragma" ; S stmt ]
- | IPCodeAnnot (kf,stmt, { annot_content = AExtended(_,_,(_,clause,_,_)) } )
+ | IPCodeAnnot (kf,stmt, { annot_content = AExtended(_,_,(_,clause,_,_,_)) } )
-> [ K kf ; A clause ; S stmt ]
| IPCodeAnnot (kf,_, { annot_content = AAssert(_,p) } ) ->
@@ -1089,9 +1135,9 @@ struct
| IPOther(name,OLContract kf) -> [ K kf ; A name ]
| IPOther(name,OLStmt(kf,s)) -> [ K kf ; A name ; S s ]
- | IPExtended(ELGlob,(_,name,_,_)) -> [ A name ]
- | IPExtended(ELContract(kf),(_,name,_,_)) -> [ K kf ; A name ]
- | IPExtended(ELStmt(kf,s),(_,name,_,_)) -> [ K kf ; A name ; S s ]
+ | IPExtended(ELGlob,(_,name,_,_,_)) -> [ A name ]
+ | IPExtended(ELContract(kf),(_,name,_,_,_)) -> [ K kf ; A name ]
+ | IPExtended(ELStmt(kf,s),(_,name,_,_,_)) -> [ K kf ; A name ; S s ]
| IPPropertyInstance (_, _, _, ip) -> parts_of_property ip
@@ -1149,12 +1195,6 @@ end
(* --- Smart Constructors --- *)
(* -------------------------------------------------------------------------- *)
-
-(* -------------------------------------------------------------------------- *)
-(* --- Smart Constructors --- *)
-(* -------------------------------------------------------------------------- *)
-
-
let ip_other s le = IPOther(s,le)
let ip_reachable_stmt kf ki = IPReachable(Some kf, Kstmt ki, Before)
@@ -1330,7 +1370,8 @@ let ip_of_code_annot kf stmt ca =
| APragma p when Logic_utils.is_property_pragma p ->
[ IPCodeAnnot (kf,stmt,ca) ]
| APragma _ -> []
- | AExtended _ -> []
+ | AExtended(_,_,(_,_,_,status,_ as ext)) ->
+ if status then [IPExtended(ELStmt(kf,stmt),ext)] else []
let ip_of_code_annot_single kf stmt ca = match ip_of_code_annot kf stmt ca with
| [] ->
diff --git a/src/kernel_services/ast_data/property.mli b/src/kernel_services/ast_data/property.mli
index 61f401c12a113f0abec2eebf75176897db61c6cb..d951fa1afb61b2990baece699c57ff35cc83b462 100644
--- a/src/kernel_services/ast_data/property.mli
+++ b/src/kernel_services/ast_data/property.mli
@@ -93,7 +93,7 @@ type identified_predicate =
type program_point = Before | After
type identified_reachable = kernel_function option * kinstr * program_point
-(** [None, Kglobal] --> global property
+(** [None, Kglobal] --> global property
[None, Some ki] --> impossible
[Some kf, Kglobal] --> property of a function without code
[Some kf, Kstmt stmt] --> reachability of the given stmt (and the attached
@@ -113,7 +113,7 @@ type identified_extended = extended_loc * Cil_types.acsl_extension
and identified_axiomatic = string * identified_property list
-and identified_lemma =
+and identified_lemma =
string * logic_label list * string list * predicate * location
and identified_axiom = identified_lemma
@@ -156,7 +156,7 @@ val short_pretty: Format.formatter -> t -> unit
corresponding identified predicate when available)
reverting back to the full ACSL formula if it can't find one.
The name is not meant to uniquely identify the property.
- @since Neon-20140301
+ @since Neon-20140301
*)
(** @since Oxygen-20120901 *)
@@ -245,7 +245,7 @@ val ip_of_allocation:
@modify Aluminium-20160501 added active argument
*)
val ip_allocation_of_behavior:
- kernel_function -> kinstr -> active:string list ->
+ kernel_function -> kinstr -> active:string list ->
funbehavior -> identified_property option
(** Builds the corresponding IPAssigns.
@@ -403,13 +403,13 @@ val ip_property_instance:
identified_property -> identified_property
(** Builds an IPAxiom.
- @since Carbon-20110201
+ @since Carbon-20110201
@modify Oxygen-20120901 takes an identified_axiom instead of a string
*)
val ip_axiom: identified_axiom -> identified_property
(** Build an IPLemma.
- @since Nitrogen-20111001
+ @since Nitrogen-20111001
@modify Oxygen-20120901 takes an identified_lemma instead of a string
*)
val ip_lemma: identified_lemma -> identified_property
@@ -437,7 +437,7 @@ val ip_of_code_annot_single:
val ip_of_global_annotation: global_annotation -> identified_property list
(** @since Nitrogen-20111001 *)
-val ip_of_global_annotation_single:
+val ip_of_global_annotation_single:
global_annotation -> identified_property option
(** @since Nitrogen-20111001 *)
@@ -445,6 +445,11 @@ val ip_of_global_annotation_single:
(** {2 getters} *)
(**************************************************************************)
+val has_status: identified_property -> bool
+(** Does the property has a logical status (which may be Never_tried)?
+ False for pragma, assumes clauses and some ACSL extensions.
+ @since Frama-C+dev *)
+
val get_kinstr: identified_property -> kinstr
val get_kf: identified_property -> kernel_function option
val get_behavior: identified_property -> funbehavior option
@@ -462,7 +467,7 @@ val source: identified_property -> Filepath.position option
(**************************************************************************)
-(** @since Frama-C+dev deprecated old naming scheeme,
+(** @since Frama-C+dev deprecated old naming scheme,
to be removed in future versions. *)
module LegacyNames :
sig
@@ -479,12 +484,12 @@ sig
val get_prop_name_id: identified_property -> string
(** returns a unique name identifying the property.
- This name is built from the basename of the property.
+ This name is built from the basename of the property.
@modify Frama-C+dev new naming scheme, Cf. LegacyNames
*)
-
+
val get_prop_basename: ?truncate:int -> identified_property -> string
- (** returns the basename of the property.
+ (** returns the basename of the property.
@modify Frama-C+dev additional truncation parameter
*)
diff --git a/src/kernel_services/ast_printing/cabs_debug.ml b/src/kernel_services/ast_printing/cabs_debug.ml
index 25dca2c6207f8d27ae96479aed86d11ac27fba69..fc191d8582406f56fdf3e527c994494655181a0d 100644
--- a/src/kernel_services/ast_printing/cabs_debug.ml
+++ b/src/kernel_services/ast_printing/cabs_debug.ml
@@ -28,80 +28,80 @@ let pp_cabsloc fmt (pos1 , _pos2) =
fprintf fmt "%d,%s" pos1.Filepath.pos_lnum (pos1.Filepath.pos_path :> string)
let pp_storage fmt = function
- | NO_STORAGE -> fprintf fmt "NO_STORAGE"
- | AUTO -> fprintf fmt "AUTO"
- | STATIC -> fprintf fmt "STATIC"
- | EXTERN -> fprintf fmt "EXTERN"
- | REGISTER -> fprintf fmt "REGISTER"
+ | NO_STORAGE -> fprintf fmt "NO_STORAGE"
+ | AUTO -> fprintf fmt "AUTO"
+ | STATIC -> fprintf fmt "STATIC"
+ | EXTERN -> fprintf fmt "EXTERN"
+ | REGISTER -> fprintf fmt "REGISTER"
let pp_fun_spec fmt = function
- | INLINE -> fprintf fmt "INLINE"
- | VIRTUAL -> fprintf fmt "VIRTUAL"
- | EXPLICIT -> fprintf fmt "EXPLICIT"
+ | INLINE -> fprintf fmt "INLINE"
+ | VIRTUAL -> fprintf fmt "VIRTUAL"
+ | EXPLICIT -> fprintf fmt "EXPLICIT"
let pp_cvspec fmt = function
- | CV_CONST -> fprintf fmt "CV_CONST"
- | CV_VOLATILE -> fprintf fmt "CV_VOLATILE"
- | CV_RESTRICT -> fprintf fmt "CV_RESTRICT"
- | CV_ATTRIBUTE_ANNOT s -> fprintf fmt "CV_ATTRIBUTE_ANNOT %s" s
+ | CV_CONST -> fprintf fmt "CV_CONST"
+ | CV_VOLATILE -> fprintf fmt "CV_VOLATILE"
+ | CV_RESTRICT -> fprintf fmt "CV_RESTRICT"
+ | CV_ATTRIBUTE_ANNOT s -> fprintf fmt "CV_ATTRIBUTE_ANNOT %s" s
let pp_const fmt = function
- | CONST_INT s -> fprintf fmt "CONST_INT %s" s
- | CONST_FLOAT s -> fprintf fmt "CONST_FLOAT %s" s
- | CONST_CHAR l ->
+ | CONST_INT s -> fprintf fmt "CONST_INT %s" s
+ | CONST_FLOAT s -> fprintf fmt "CONST_FLOAT %s" s
+ | CONST_CHAR l ->
fprintf fmt "CONST_CHAR{";
List.iter (fun i -> fprintf fmt ",@ %s" (Int64.to_string i)) l;
fprintf fmt "}"
- | CONST_WCHAR l ->
+ | CONST_WCHAR l ->
fprintf fmt "CONST_WCHAR{";
List.iter (fun i -> fprintf fmt ",@ %s" (Int64.to_string i)) l;
fprintf fmt "}"
- | CONST_STRING s -> fprintf fmt "CONST_STRING %s" s
- | CONST_WSTRING l ->
+ | CONST_STRING s -> fprintf fmt "CONST_STRING %s" s
+ | CONST_WSTRING l ->
fprintf fmt "CONST_WSTRING{";
List.iter (fun i -> fprintf fmt ",@ %s" (Int64.to_string i)) l;
fprintf fmt "}"
let pp_labels fmt lbls =
fprintf fmt "%s" (String.concat " " lbls)
-
-
+
+
let rec pp_typeSpecifier fmt = function
| Tvoid -> fprintf fmt "Tvoid"
- | Tchar -> fprintf fmt "Tchar"
- | Tbool -> fprintf fmt "Tbool"
- | Tshort -> fprintf fmt "Tshort"
- | Tint -> fprintf fmt "Tint"
- | Tlong -> fprintf fmt "Tlong"
- | Tint64 -> fprintf fmt "Tint64"
- | Tfloat -> fprintf fmt "Tfloat"
- | Tdouble -> fprintf fmt "Tdouble"
- | Tsigned -> fprintf fmt "Tsigned"
- | Tunsigned -> fprintf fmt "Tunsigned"
- | Tnamed s -> fprintf fmt "%s" s
- | Tstruct (sname, None, alist) -> fprintf fmt "struct@ %s {} %a" sname pp_attrs alist
- | Tstruct (sname, Some fd_gp_list, alist) ->
+ | Tchar -> fprintf fmt "Tchar"
+ | Tbool -> fprintf fmt "Tbool"
+ | Tshort -> fprintf fmt "Tshort"
+ | Tint -> fprintf fmt "Tint"
+ | Tlong -> fprintf fmt "Tlong"
+ | Tint64 -> fprintf fmt "Tint64"
+ | Tfloat -> fprintf fmt "Tfloat"
+ | Tdouble -> fprintf fmt "Tdouble"
+ | Tsigned -> fprintf fmt "Tsigned"
+ | Tunsigned -> fprintf fmt "Tunsigned"
+ | Tnamed s -> fprintf fmt "%s" s
+ | Tstruct (sname, None, alist) -> fprintf fmt "struct@ %s {} %a" sname pp_attrs alist
+ | Tstruct (sname, Some fd_gp_list, alist) ->
fprintf fmt "struct@ %s {%a}@ attrs=(%a)" sname pp_field_groups fd_gp_list pp_attrs alist
- | Tunion (uname, None, alist) -> fprintf fmt "union@ %s {} %a" uname pp_attrs alist
+ | Tunion (uname, None, alist) -> fprintf fmt "union@ %s {} %a" uname pp_attrs alist
| Tunion (uname, Some fd_gp_list, alist) ->
fprintf fmt "union@ %s {%a}@ attrs=(%a)" uname pp_field_groups fd_gp_list pp_attrs alist
- | Tenum (ename, None, alist) -> fprintf fmt "enum@ %s {} %a" ename pp_attrs alist
- | Tenum (ename, Some e_item_list, alist) ->
+ | Tenum (ename, None, alist) -> fprintf fmt "enum@ %s {} %a" ename pp_attrs alist
+ | Tenum (ename, Some e_item_list, alist) ->
fprintf fmt "enum@ %s {" ename;
List.iter (fun e -> fprintf fmt ",@ %a" pp_enum_item e) e_item_list;
fprintf fmt "}@ %a" pp_attrs alist;
- | TtypeofE exp -> fprintf fmt "typeOfE %a" pp_exp exp
- | TtypeofT (spec, d_type) -> fprintf fmt "typeOfT(%a,%a)" pp_spec spec pp_decl_type d_type
+ | TtypeofE exp -> fprintf fmt "typeOfE %a" pp_exp exp
+ | TtypeofT (spec, d_type) -> fprintf fmt "typeOfT(%a,%a)" pp_spec spec pp_decl_type d_type
and pp_spec_elem fmt = function
- | SpecTypedef -> fprintf fmt "SpecTypedef"
- | SpecCV cvspec -> fprintf fmt "SpecCV %a" pp_cvspec cvspec
- | SpecAttr attr -> fprintf fmt "SpecAttr %a" pp_attr attr
- | SpecStorage storage -> fprintf fmt "SpecStorage %a" pp_storage storage
- | SpecInline -> fprintf fmt "SpecInline"
- | SpecType typeSpec -> fprintf fmt "SpecType %a" pp_typeSpecifier typeSpec
- | SpecPattern s -> fprintf fmt "SpecPattern %s" s
+ | SpecTypedef -> fprintf fmt "SpecTypedef"
+ | SpecCV cvspec -> fprintf fmt "SpecCV %a" pp_cvspec cvspec
+ | SpecAttr attr -> fprintf fmt "SpecAttr %a" pp_attr attr
+ | SpecStorage storage -> fprintf fmt "SpecStorage %a" pp_storage storage
+ | SpecInline -> fprintf fmt "SpecInline"
+ | SpecType typeSpec -> fprintf fmt "SpecType %a" pp_typeSpecifier typeSpec
+ | SpecPattern s -> fprintf fmt "SpecPattern %s" s
and pp_spec fmt spec_elems =
fprintf fmt "@[<hv 2>{" ;
@@ -111,17 +111,17 @@ and pp_spec fmt spec_elems =
fprintf fmt "} @]"
and pp_decl_type fmt = function
- | JUSTBASE -> fprintf fmt "@[<hov 2>JUSTBASE@]"
- | PARENTYPE (attrs1, decl_type, attrs2)
- -> fprintf fmt "@[<hov 2>PARENTYPE(%a, %a, %a)@]" pp_attrs attrs1 pp_decl_type decl_type pp_attrs attrs2
- | ARRAY (decl_type, attrs, exp)
- -> fprintf fmt "@[<hov 2>ARRAY[%a, %a, %a]@]" pp_decl_type decl_type pp_attrs attrs pp_exp exp
- | PTR (attrs, decl_type) -> fprintf fmt "@[<hov 2>PTR(%a, %a)@]" pp_attrs attrs pp_decl_type decl_type
- | PROTO (decl_type, single_names, b)
+ | JUSTBASE -> fprintf fmt "@[<hov 2>JUSTBASE@]"
+ | PARENTYPE (attrs1, decl_type, attrs2)
+ -> fprintf fmt "@[<hov 2>PARENTYPE(%a, %a, %a)@]" pp_attrs attrs1 pp_decl_type decl_type pp_attrs attrs2
+ | ARRAY (decl_type, attrs, exp)
+ -> fprintf fmt "@[<hov 2>ARRAY[%a, %a, %a]@]" pp_decl_type decl_type pp_attrs attrs pp_exp exp
+ | PTR (attrs, decl_type) -> fprintf fmt "@[<hov 2>PTR(%a, %a)@]" pp_attrs attrs pp_decl_type decl_type
+ | PROTO (decl_type, single_names, b)
-> fprintf fmt "@[<hov 2>PROTO decl_type(%a), single_names(" pp_decl_type decl_type;
- List.iter (fun sn -> fprintf fmt ",@ %a" pp_single_name sn) single_names;
- fprintf fmt "),@ %b@]" b
-
+ List.iter (fun sn -> fprintf fmt ",@ %a" pp_single_name sn) single_names;
+ fprintf fmt "),@ %b@]" b
+
and pp_name_group fmt (spec, names) =
fprintf fmt "@[<hov 2>name_group@ spec(%a), names{" pp_spec spec;
List.iter
@@ -135,7 +135,7 @@ and pp_field_group fmt = function
fprintf fmt "@[<hov 2>FIELD spec(%a), {" pp_spec spec;
List.iter
(fun (n,e_opt) -> fprintf fmt "@ %a" pp_name n;
- match e_opt with Some exp -> fprintf fmt "@ %a" pp_exp exp | _ -> ())
+ match e_opt with Some exp -> fprintf fmt "@ %a" pp_exp exp | _ -> ())
l;
fprintf fmt "}@]"
| TYPE_ANNOT _ -> fprintf fmt "TYPE_ANNOT"
@@ -151,43 +151,43 @@ and pp_init_name_group fmt (spec,init_names) =
( fun i -> fprintf fmt "@ %a" pp_init_name i)
init_names;
fprintf fmt "}@]"
-
+
and pp_name fmt (s,decl_type,attrs,loc) =
fprintf fmt "name %s, decl_type(%a), attrs(%a), loc(%a)"
s pp_decl_type decl_type pp_attrs attrs pp_cabsloc loc
-
+
and pp_init_name fmt (name,init_exp) =
fprintf fmt "init_name name(%a), init_exp(%a)" pp_name name pp_init_exp init_exp
-
+
and pp_single_name fmt (spec,name) =
fprintf fmt "@[<hov 2>single_name{spec(%a), name(%a)}@]" pp_spec spec pp_name name
-
+
and pp_enum_item fmt (s,exp,loc) =
fprintf fmt "@[<hov 2>enum_item %s, exp(%a, loc(%a))@]" s pp_exp exp pp_cabsloc loc
(* Warning : printing for GLOBANNOT and CUSTOM is not complete *)
and pp_def fmt = function
- | FUNDEF (_, single_name, bl, loc1, loc2) ->
+ | FUNDEF (_, single_name, bl, loc1, loc2) ->
fprintf fmt "@[<hov 2>FUNDEF (%a), loc1(%a), loc2(%a) {%a} @]"
pp_single_name single_name pp_cabsloc loc1 pp_cabsloc loc2 pp_block bl
- | DECDEF (_, init_name_group, loc) ->
+ | DECDEF (_, init_name_group, loc) ->
fprintf fmt "@[<hov 2>DECDEF (%a, loc(%a))@]" pp_init_name_group init_name_group pp_cabsloc loc
- | TYPEDEF (name_group, loc) -> (* typedef normal *)
- fprintf fmt "@[<hov 2>TYPEDEF (%a), loc(%a)@]" pp_name_group name_group pp_cabsloc loc
- | ONLYTYPEDEF (spec, loc) -> (* ex : struct s{...}; *)
- fprintf fmt "@[<hov 2>ONLYTYPEDEF (%a), loc(%a)@]" pp_spec spec pp_cabsloc loc
- | GLOBASM (s, loc) ->
- fprintf fmt "@[<hov 2>GLOBASM %s, loc(%a)@]" s pp_cabsloc loc
- | PRAGMA (exp, loc) ->
+ | TYPEDEF (name_group, loc) -> (* typedef normal *)
+ fprintf fmt "@[<hov 2>TYPEDEF (%a), loc(%a)@]" pp_name_group name_group pp_cabsloc loc
+ | ONLYTYPEDEF (spec, loc) -> (* ex : struct s{...}; *)
+ fprintf fmt "@[<hov 2>ONLYTYPEDEF (%a), loc(%a)@]" pp_spec spec pp_cabsloc loc
+ | GLOBASM (s, loc) ->
+ fprintf fmt "@[<hov 2>GLOBASM %s, loc(%a)@]" s pp_cabsloc loc
+ | PRAGMA (exp, loc) ->
fprintf fmt "@[<hov 2>PRAGMA exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
- | LINKAGE (s, loc, defs) ->
+ | LINKAGE (s, loc, defs) ->
fprintf fmt "@[<hov 2>LINKAGE %s, loc(%a), defs(" s pp_cabsloc loc;
List.iter (fun def -> fprintf fmt ",@ def(%a)" pp_def def) defs;
fprintf fmt ")@]"
- | GLOBANNOT _ -> fprintf fmt "GLOBANNOT"
- | CUSTOM _ -> fprintf fmt "CUSTOM"
-
+ | GLOBANNOT _ -> fprintf fmt "GLOBANNOT"
+ | CUSTOM _ -> fprintf fmt "CUSTOM"
+
and pp_file fmt (s,l) =
fprintf fmt "@[FILE %a, {" Filepath.Normalized.pp_abs s;
List.iter
@@ -196,7 +196,7 @@ and pp_file fmt (s,l) =
fprintf fmt "@] }"
and pp_block fmt bl =
- fprintf fmt "@[<hv 2>labels(%a), attrs(%a), {" pp_labels bl.blabels pp_attrs bl.battrs;
+ fprintf fmt "@[<hv 2>labels(%a), attrs(%a), {" pp_labels bl.blabels pp_attrs bl.battrs;
List.iter
(fun s -> fprintf fmt "@ %a" pp_stmt s)
bl.bstmts ;
@@ -204,48 +204,48 @@ and pp_block fmt bl =
(* Warning : printing for ASM, CODE_ANNOT and CODE_SPEC is not complete *)
and pp_raw_stmt fmt = function
- | NOP loc -> fprintf fmt "@[<hov 2>NOP loc(%a)@]" pp_cabsloc loc
- | COMPUTATION (exp, loc) ->
- fprintf fmt "@[<hov 2>COMPUTATION exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
- | BLOCK (bl, loc1, loc2) ->
- fprintf fmt "@[<hov 2>BLOCK loc1(%a), loc2(%a) {%a} @]"
- pp_cabsloc loc1 pp_cabsloc loc2 pp_block bl
- | SEQUENCE (stmt1, stmt2, loc) ->
+ | NOP loc -> fprintf fmt "@[<hov 2>NOP loc(%a)@]" pp_cabsloc loc
+ | COMPUTATION (exp, loc) ->
+ fprintf fmt "@[<hov 2>COMPUTATION exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
+ | BLOCK (bl, loc1, loc2) ->
+ fprintf fmt "@[<hov 2>BLOCK loc1(%a), loc2(%a) {%a} @]"
+ pp_cabsloc loc1 pp_cabsloc loc2 pp_block bl
+ | SEQUENCE (stmt1, stmt2, loc) ->
fprintf fmt "@[<hov 2>SEQUENCE stmt(%a), stmt(%a), loc(%a)@]" pp_stmt stmt1 pp_stmt stmt2 pp_cabsloc loc
- | IF (exp, stmt1, stmt2, loc) ->
+ | IF (exp, stmt1, stmt2, loc) ->
fprintf fmt "@[<hov 2>IF cond(%a), stmt(%a), stmt(%a), loc(%a)@]"
- pp_exp exp pp_stmt stmt1 pp_stmt stmt2 pp_cabsloc loc
- | WHILE (_loop_inv, exp, stmt, loc) -> (* Warning : no printing for loop_invariant *)
- fprintf fmt "@[<hov 2>WHILE cond(%a), stmt(%a), loc(%a)@]"
- pp_exp exp pp_stmt stmt pp_cabsloc loc
- | DOWHILE (_loop_inv, exp, stmt, loc) -> (* Warning : no printing for loop_invariant *)
+ pp_exp exp pp_stmt stmt1 pp_stmt stmt2 pp_cabsloc loc
+ | WHILE (_loop_inv, exp, stmt, loc) -> (* Warning : no printing for loop_invariant *)
+ fprintf fmt "@[<hov 2>WHILE cond(%a), stmt(%a), loc(%a)@]"
+ pp_exp exp pp_stmt stmt pp_cabsloc loc
+ | DOWHILE (_loop_inv, exp, stmt, loc) -> (* Warning : no printing for loop_invariant *)
fprintf fmt "@[<hov 2>DOWHILE cond(%a), stmt(%a), loc(%a)@]"
- pp_exp exp pp_stmt stmt pp_cabsloc loc
- | FOR (_loop_inv, for_clause, exp1, exp2, stmt, loc) -> (* Warning : no printing for loop_invariant *)
+ pp_exp exp pp_stmt stmt pp_cabsloc loc
+ | FOR (_loop_inv, for_clause, exp1, exp2, stmt, loc) -> (* Warning : no printing for loop_invariant *)
fprintf fmt "@[<hov 2>FOR for_clause(%a), exp1(%a), exp2(%a), stmt(%a), loc(%a)@]"
- pp_for_clause for_clause pp_exp exp1 pp_exp exp2 pp_stmt stmt pp_cabsloc loc
- | BREAK loc -> fprintf fmt "@[<hov 2>BREAK loc(%a)@]" pp_cabsloc loc
- | CONTINUE loc -> fprintf fmt "@[<hov 2>CONTINUE loc(%a)@]" pp_cabsloc loc
- | RETURN (exp, loc) -> fprintf fmt "@[<hov 2>RETURN exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
- | SWITCH (exp, stmt, loc) ->
+ pp_for_clause for_clause pp_exp exp1 pp_exp exp2 pp_stmt stmt pp_cabsloc loc
+ | BREAK loc -> fprintf fmt "@[<hov 2>BREAK loc(%a)@]" pp_cabsloc loc
+ | CONTINUE loc -> fprintf fmt "@[<hov 2>CONTINUE loc(%a)@]" pp_cabsloc loc
+ | RETURN (exp, loc) -> fprintf fmt "@[<hov 2>RETURN exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
+ | SWITCH (exp, stmt, loc) ->
fprintf fmt "@[<hov 2>SWITH exp(%a), stmt(%a), loc(%a)@]" pp_exp exp pp_stmt stmt pp_cabsloc loc
- | CASE (exp, stmt, loc) ->
+ | CASE (exp, stmt, loc) ->
fprintf fmt "@[<hov 2>CASE exp(%a), stmt(%a), loc(%a)@]" pp_exp exp pp_stmt stmt pp_cabsloc loc
- | CASERANGE (exp1, exp2, stmt, loc) ->
+ | CASERANGE (exp1, exp2, stmt, loc) ->
fprintf fmt "@[<hov 2>CASE exp(%a), exp(%a), stmt(%a), loc(%a)@]" pp_exp exp1 pp_exp exp2 pp_stmt stmt pp_cabsloc loc
- | DEFAULT (stmt, loc) ->
+ | DEFAULT (stmt, loc) ->
fprintf fmt "@[<hov 2>DEFAULT stmt(%a), loc(%a)@]" pp_stmt stmt pp_cabsloc loc
- | LABEL (s, stmt, loc) ->
+ | LABEL (s, stmt, loc) ->
fprintf fmt "@[<hov 2>LABEL %s stmt(%a), loc(%a)@]" s pp_stmt stmt pp_cabsloc loc
- | GOTO (s, loc) ->
+ | GOTO (s, loc) ->
fprintf fmt "@[<hov 2>GOTO %s, loc(%a)@]" s pp_cabsloc loc
- | COMPGOTO (exp, loc) -> fprintf fmt "@[<hov 2>COMPGOTO exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
- | DEFINITION def -> fprintf fmt "@[<hov 2>DEFINITION %a@]" pp_def def
- | ASM (_,_,_,_) -> fprintf fmt "ASM"
- | TRY_EXCEPT (bl1, exp, bl2, loc) ->
+ | COMPGOTO (exp, loc) -> fprintf fmt "@[<hov 2>COMPGOTO exp(%a, loc(%a))@]" pp_exp exp pp_cabsloc loc
+ | DEFINITION def -> fprintf fmt "@[<hov 2>DEFINITION %a@]" pp_def def
+ | ASM (_,_,_,_) -> fprintf fmt "ASM"
+ | TRY_EXCEPT (bl1, exp, bl2, loc) ->
fprintf fmt "@[<hov 2>TRY_EXCEPT block(%a) exp(%a) block(%a) loc(%a)@]"
pp_block bl1 pp_exp exp pp_block bl2 pp_cabsloc loc
- | TRY_FINALLY (bl1, bl2, loc) ->
+ | TRY_FINALLY (bl1, bl2, loc) ->
fprintf fmt "@[<hov 2>TRY_EXCEPT block(%a) block(%a) loc(%a)@]"
pp_block bl1 pp_block bl2 pp_cabsloc loc
| THROW(e,loc) ->
@@ -261,7 +261,7 @@ and pp_raw_stmt fmt = function
pp_stmt s
pp_cabsloc loc
(Pretty_utils.pp_list ~sep:"@;" print_one_catch) l
- | CODE_ANNOT (_,_) -> fprintf fmt "CODE_ANNOT"
+ | CODE_ANNOT (_,_) -> fprintf fmt "CODE_ANNOT"
| CODE_SPEC _ -> fprintf fmt "CODE_SPEC"
and pp_stmt fmt stmt =
@@ -270,129 +270,129 @@ and pp_stmt fmt stmt =
(*and loop_invariant = Logic_ptree.code_annot list *)
and pp_for_clause fmt = function
- | FC_EXP exp -> fprintf fmt "@[<hov 2>FC_EXP %a@]" pp_exp exp
- | FC_DECL def -> fprintf fmt "@[<hov 2>FC_DECL %a@]" pp_def def
-
+ | FC_EXP exp -> fprintf fmt "@[<hov 2>FC_EXP %a@]" pp_exp exp
+ | FC_DECL def -> fprintf fmt "@[<hov 2>FC_DECL %a@]" pp_def def
+
and pp_bin_op fmt = function
- | ADD -> fprintf fmt "ADD"
- | SUB -> fprintf fmt "SUB"
- | MUL -> fprintf fmt "MUL"
- | DIV -> fprintf fmt "DIV"
- | MOD -> fprintf fmt "MOD"
- | AND -> fprintf fmt "AND"
- | OR -> fprintf fmt "OR"
- | BAND -> fprintf fmt "BAND"
- | BOR -> fprintf fmt "BOR"
- | XOR -> fprintf fmt "XOR"
- | SHL -> fprintf fmt "SHL"
- | SHR -> fprintf fmt "SHR"
- | EQ -> fprintf fmt "EQ"
- | NE -> fprintf fmt "NE"
- | LT -> fprintf fmt "LT"
- | GT -> fprintf fmt "GT"
- | LE -> fprintf fmt "LE"
- | GE -> fprintf fmt "GE"
- | ASSIGN -> fprintf fmt "ASSIGN"
- | ADD_ASSIGN -> fprintf fmt "ADD_ASSIGN"
- | SUB_ASSIGN -> fprintf fmt "SUB_ASSIGN"
- | MUL_ASSIGN -> fprintf fmt "MUL_ASSIGN"
- | DIV_ASSIGN -> fprintf fmt "DIV_ASSIGN"
- | MOD_ASSIGN -> fprintf fmt "MOD_ASSIGN"
- | BAND_ASSIGN -> fprintf fmt "BAND_ASSIGN"
- | BOR_ASSIGN -> fprintf fmt "BOR_ASSIGN"
- | XOR_ASSIGN -> fprintf fmt "XOR_ASSIGN"
- | SHL_ASSIGN -> fprintf fmt "SHL_ASSIGN"
- | SHR_ASSIGN -> fprintf fmt "SHR_ASSIGN"
+ | ADD -> fprintf fmt "ADD"
+ | SUB -> fprintf fmt "SUB"
+ | MUL -> fprintf fmt "MUL"
+ | DIV -> fprintf fmt "DIV"
+ | MOD -> fprintf fmt "MOD"
+ | AND -> fprintf fmt "AND"
+ | OR -> fprintf fmt "OR"
+ | BAND -> fprintf fmt "BAND"
+ | BOR -> fprintf fmt "BOR"
+ | XOR -> fprintf fmt "XOR"
+ | SHL -> fprintf fmt "SHL"
+ | SHR -> fprintf fmt "SHR"
+ | EQ -> fprintf fmt "EQ"
+ | NE -> fprintf fmt "NE"
+ | LT -> fprintf fmt "LT"
+ | GT -> fprintf fmt "GT"
+ | LE -> fprintf fmt "LE"
+ | GE -> fprintf fmt "GE"
+ | ASSIGN -> fprintf fmt "ASSIGN"
+ | ADD_ASSIGN -> fprintf fmt "ADD_ASSIGN"
+ | SUB_ASSIGN -> fprintf fmt "SUB_ASSIGN"
+ | MUL_ASSIGN -> fprintf fmt "MUL_ASSIGN"
+ | DIV_ASSIGN -> fprintf fmt "DIV_ASSIGN"
+ | MOD_ASSIGN -> fprintf fmt "MOD_ASSIGN"
+ | BAND_ASSIGN -> fprintf fmt "BAND_ASSIGN"
+ | BOR_ASSIGN -> fprintf fmt "BOR_ASSIGN"
+ | XOR_ASSIGN -> fprintf fmt "XOR_ASSIGN"
+ | SHL_ASSIGN -> fprintf fmt "SHL_ASSIGN"
+ | SHR_ASSIGN -> fprintf fmt "SHR_ASSIGN"
and pp_un_op fmt = function
- | MINUS -> fprintf fmt "MINUS"
- | PLUS -> fprintf fmt "PLUS"
- | NOT -> fprintf fmt "NOT"
- | BNOT -> fprintf fmt "BNOT"
- | MEMOF -> fprintf fmt "MEMOF"
- | ADDROF -> fprintf fmt "ADDROF"
- | PREINCR -> fprintf fmt "PREINCR"
- | PREDECR -> fprintf fmt "PREDECR"
- | POSINCR -> fprintf fmt "POSINCR"
- | POSDECR -> fprintf fmt "POSDECR"
+ | MINUS -> fprintf fmt "MINUS"
+ | PLUS -> fprintf fmt "PLUS"
+ | NOT -> fprintf fmt "NOT"
+ | BNOT -> fprintf fmt "BNOT"
+ | MEMOF -> fprintf fmt "MEMOF"
+ | ADDROF -> fprintf fmt "ADDROF"
+ | PREINCR -> fprintf fmt "PREINCR"
+ | PREDECR -> fprintf fmt "PREDECR"
+ | POSINCR -> fprintf fmt "POSINCR"
+ | POSDECR -> fprintf fmt "POSDECR"
and pp_exp fmt exp =
fprintf fmt "exp(%a)" pp_exp_node exp.expr_node
-
+
and pp_exp_node fmt = function
- | NOTHING -> fprintf fmt "NOTHING"
- | UNARY (un_op, exp) -> fprintf fmt "@[<hov 2>%a(%a)@]" pp_un_op un_op pp_exp exp
- | LABELADDR s -> fprintf fmt "@[<hov 2>LABELADDR %s@]" s
- | BINARY (bin_op, exp1, exp2) ->
- fprintf fmt "@[<hov 2>%a %a %a@]" pp_exp exp1 pp_bin_op bin_op pp_exp exp2
- | QUESTION (exp1, exp2, exp3) ->
- fprintf fmt "@[<hov 2>QUESTION(%a, %a, %a)@]" pp_exp exp1 pp_exp exp2 pp_exp exp3
- | CAST ((spec, decl_type), init_exp) ->
- fprintf fmt "@[<hov 2>CAST (%a, %a) %a@]" pp_spec spec pp_decl_type decl_type pp_init_exp init_exp
- | CALL (exp1, exps) ->
- fprintf fmt "@[<hov 2>CALL %a {" pp_exp exp1;
- List.iter
- (fun e -> fprintf fmt ",@ %a" pp_exp e)
- exps;
- fprintf fmt "}@]"
- | COMMA exps ->
- fprintf fmt "@[<hov 2>COMMA {";
- List.iter
- (fun e -> fprintf fmt ",@ %a" pp_exp e)
- exps;
- fprintf fmt "}@]"
- | CONSTANT c -> fprintf fmt "%a" pp_const c
- | PAREN exp -> fprintf fmt "PAREN(%a)" pp_exp exp
- | VARIABLE s -> fprintf fmt "VAR %s" s
- | EXPR_SIZEOF exp -> fprintf fmt "EXPR_SIZEOF(%a)" pp_exp exp
- | TYPE_SIZEOF (spec, decl_type) ->
- fprintf fmt "TYP_SIZEOF(%a,%a)" pp_spec spec pp_decl_type decl_type
- | EXPR_ALIGNOF exp ->
- fprintf fmt "EXPR_ALIGNOF(%a)" pp_exp exp
- | TYPE_ALIGNOF (spec, decl_type) ->
- fprintf fmt "TYP_ALIGNEOF(%a,%a)" pp_spec spec pp_decl_type decl_type
- | INDEX (exp1, exp2) ->
- fprintf fmt "INDEX(%a, %a)" pp_exp exp1 pp_exp exp2
- | MEMBEROF (exp, s) ->
- fprintf fmt "MEMBEROF(%a,%s)" pp_exp exp s
- | MEMBEROFPTR (exp, s) ->
- fprintf fmt "MEMBEROFPTR(%a,%s)" pp_exp exp s
- | GNU_BODY bl -> fprintf fmt "GNU_BODY %a" pp_block bl
- | EXPR_PATTERN s -> fprintf fmt "EXPR_PATTERN %s" s
-
+ | NOTHING -> fprintf fmt "NOTHING"
+ | UNARY (un_op, exp) -> fprintf fmt "@[<hov 2>%a(%a)@]" pp_un_op un_op pp_exp exp
+ | LABELADDR s -> fprintf fmt "@[<hov 2>LABELADDR %s@]" s
+ | BINARY (bin_op, exp1, exp2) ->
+ fprintf fmt "@[<hov 2>%a %a %a@]" pp_exp exp1 pp_bin_op bin_op pp_exp exp2
+ | QUESTION (exp1, exp2, exp3) ->
+ fprintf fmt "@[<hov 2>QUESTION(%a, %a, %a)@]" pp_exp exp1 pp_exp exp2 pp_exp exp3
+ | CAST ((spec, decl_type), init_exp) ->
+ fprintf fmt "@[<hov 2>CAST (%a, %a) %a@]" pp_spec spec pp_decl_type decl_type pp_init_exp init_exp
+ | CALL (exp1, exps) ->
+ fprintf fmt "@[<hov 2>CALL %a {" pp_exp exp1;
+ List.iter
+ (fun e -> fprintf fmt ",@ %a" pp_exp e)
+ exps;
+ fprintf fmt "}@]"
+ | COMMA exps ->
+ fprintf fmt "@[<hov 2>COMMA {";
+ List.iter
+ (fun e -> fprintf fmt ",@ %a" pp_exp e)
+ exps;
+ fprintf fmt "}@]"
+ | CONSTANT c -> fprintf fmt "%a" pp_const c
+ | PAREN exp -> fprintf fmt "PAREN(%a)" pp_exp exp
+ | VARIABLE s -> fprintf fmt "VAR %s" s
+ | EXPR_SIZEOF exp -> fprintf fmt "EXPR_SIZEOF(%a)" pp_exp exp
+ | TYPE_SIZEOF (spec, decl_type) ->
+ fprintf fmt "TYP_SIZEOF(%a,%a)" pp_spec spec pp_decl_type decl_type
+ | EXPR_ALIGNOF exp ->
+ fprintf fmt "EXPR_ALIGNOF(%a)" pp_exp exp
+ | TYPE_ALIGNOF (spec, decl_type) ->
+ fprintf fmt "TYP_ALIGNEOF(%a,%a)" pp_spec spec pp_decl_type decl_type
+ | INDEX (exp1, exp2) ->
+ fprintf fmt "INDEX(%a, %a)" pp_exp exp1 pp_exp exp2
+ | MEMBEROF (exp, s) ->
+ fprintf fmt "MEMBEROF(%a,%s)" pp_exp exp s
+ | MEMBEROFPTR (exp, s) ->
+ fprintf fmt "MEMBEROFPTR(%a,%s)" pp_exp exp s
+ | GNU_BODY bl -> fprintf fmt "GNU_BODY %a" pp_block bl
+ | EXPR_PATTERN s -> fprintf fmt "EXPR_PATTERN %s" s
+
and pp_init_exp fmt = function
- | NO_INIT -> fprintf fmt "NO_INIT"
- | SINGLE_INIT exp ->
+ | NO_INIT -> fprintf fmt "NO_INIT"
+ | SINGLE_INIT exp ->
fprintf fmt "SINGLE_INIT %a" pp_exp exp
- | COMPOUND_INIT l ->
+ | COMPOUND_INIT l ->
fprintf fmt "@[<hov 2>COMPOUND_INIT {";
match l with
- | [] -> fprintf fmt "}@]"
- | (iw, ie)::rest ->
- fprintf fmt ",@ (%a, %a)" pp_initwhat iw pp_init_exp ie;
- List.iter (fun (iw, ie) -> fprintf fmt ",@ (%a, %a)" pp_initwhat iw pp_init_exp ie) rest;
- fprintf fmt "}@]"
-
+ | [] -> fprintf fmt "}@]"
+ | (iw, ie)::rest ->
+ fprintf fmt ",@ (%a, %a)" pp_initwhat iw pp_init_exp ie;
+ List.iter (fun (iw, ie) -> fprintf fmt ",@ (%a, %a)" pp_initwhat iw pp_init_exp ie) rest;
+ fprintf fmt "}@]"
+
and pp_initwhat fmt = function
- | NEXT_INIT -> fprintf fmt "NEXT_INIT"
- | INFIELD_INIT (s,iw) -> fprintf fmt "@[<hov 2>INFIELD_INIT (%s, %a)@]" s pp_initwhat iw
- | ATINDEX_INIT (exp,iw) -> fprintf fmt "@[<hov 2>ATINDEX_INIT (%a, %a)@]" pp_exp exp pp_initwhat iw
- | ATINDEXRANGE_INIT (exp1, exp2) -> fprintf fmt "@[<hov 2>ATINDEXRANGE_INIT (%a, %a)@]" pp_exp exp1 pp_exp exp2
-
+ | NEXT_INIT -> fprintf fmt "NEXT_INIT"
+ | INFIELD_INIT (s,iw) -> fprintf fmt "@[<hov 2>INFIELD_INIT (%s, %a)@]" s pp_initwhat iw
+ | ATINDEX_INIT (exp,iw) -> fprintf fmt "@[<hov 2>ATINDEX_INIT (%a, %a)@]" pp_exp exp pp_initwhat iw
+ | ATINDEXRANGE_INIT (exp1, exp2) -> fprintf fmt "@[<hov 2>ATINDEXRANGE_INIT (%a, %a)@]" pp_exp exp1 pp_exp exp2
+
and pp_attr fmt (s,el) =
fprintf fmt "ATTR (%s, {" s;
match el with
- | [] -> fprintf fmt "})"
- | e :: es ->
- fprintf fmt ",@ %a" pp_exp e;
- List.iter (fun e -> fprintf fmt ",@ %a" pp_exp e) es;
- fprintf fmt "})"
+ | [] -> fprintf fmt "})"
+ | e :: es ->
+ fprintf fmt ",@ %a" pp_exp e;
+ List.iter (fun e -> fprintf fmt ",@ %a" pp_exp e) es;
+ fprintf fmt "})"
and pp_attrs fmt l =
fprintf fmt "{";
match l with
- | [] -> fprintf fmt "}"
- | a :: attrs ->
- fprintf fmt ",@ %a" pp_attr a;
- List.iter (fun a -> fprintf fmt ",@ %a" pp_attr a) attrs;
- fprintf fmt "}"
+ | [] -> fprintf fmt "}"
+ | a :: attrs ->
+ fprintf fmt ",@ %a" pp_attr a;
+ List.iter (fun a -> fprintf fmt ",@ %a" pp_attr a) attrs;
+ fprintf fmt "}"
diff --git a/src/kernel_services/ast_printing/cil_descriptive_printer.ml b/src/kernel_services/ast_printing/cil_descriptive_printer.ml
index f4c2885c06426178197a2e74108e4b3f5fc03843..214371c00f75e19b5367dfe6f508fc296b38b869 100644
--- a/src/kernel_services/ast_printing/cil_descriptive_printer.ml
+++ b/src/kernel_services/ast_printing/cil_descriptive_printer.ml
@@ -37,15 +37,15 @@ class descriptive_printer = object (self)
match vi.vdescr with
| Some vd ->
if vi.vdescrpure || not useTemps then
- Format.fprintf fmt "%s" vd
+ Format.fprintf fmt "%s" vd
else begin
- try
- let _, name, _ = List.find (fun (vi', _, _) -> vi == vi') temps in
- Format.fprintf fmt "%s" name
- with Not_found ->
- let name = "tmp" ^ string_of_int (List.length temps) in
- temps <- (vi, name, vi.vdescr) :: temps;
- Format.fprintf fmt "%s" name
+ try
+ let _, name, _ = List.find (fun (vi', _, _) -> vi == vi') temps in
+ Format.fprintf fmt "%s" name
+ with Not_found ->
+ let name = "tmp" ^ string_of_int (List.length temps) in
+ temps <- (vi, name, vi.vdescr) :: temps;
+ Format.fprintf fmt "%s" name
end
| None ->
super#varinfo fmt vi
@@ -55,13 +55,13 @@ class descriptive_printer = object (self)
but we shouldn't substitute there since "foo(a,b) = foo(a,b)"
would make no sense to the user.) *)
method! exp fmt e = match e.enode with
- | Lval (Var vi, o)
- | StartOf (Var vi, o) ->
- Format.fprintf fmt "%a%a" self#pVarDescriptive vi self#offset o
- | AddrOf (Var vi, o) ->
- (* No parens needed, since offsets have higher precedence than & *)
- Format.fprintf fmt "& %a%a" self#pVarDescriptive vi self#offset o
- | _ -> super#exp fmt e
+ | Lval (Var vi, o)
+ | StartOf (Var vi, o) ->
+ Format.fprintf fmt "%a%a" self#pVarDescriptive vi self#offset o
+ | AddrOf (Var vi, o) ->
+ (* No parens needed, since offsets have higher precedence than & *)
+ Format.fprintf fmt "& %a%a" self#pVarDescriptive vi self#offset o
+ | _ -> super#exp fmt e
end
diff --git a/src/kernel_services/ast_printing/cil_printer.ml b/src/kernel_services/ast_printing/cil_printer.ml
index 583f672121c9f591f3c6691ecf4d37bf5a1726a9..794e1cc8d4f85f7a6557b614e080cd2671c60663 100644
--- a/src/kernel_services/ast_printing/cil_printer.ml
+++ b/src/kernel_services/ast_printing/cil_printer.ml
@@ -42,7 +42,7 @@ module Behavior_extensions = struct
| Ext_preds preds ->
Pretty_utils.pp_list ~sep:",@ " printer#predicate fmt preds
- let pp (printer) fmt (_, name, _, ext) =
+ let pp (printer) fmt (_,name,_,_,ext) =
let pp =
try
Hashtbl.find printer_tbl name
@@ -273,7 +273,7 @@ module Precedence = struct
(* Multiplicative *)
| TBinOp((Div|Mod|Mult),_,_) -> multiplicativeLevel
| Tapp({ l_var_info },[],[_;_])
- when l_var_info.lv_name = "\\repeat" -> bitwiseLevel
+ when l_var_info.lv_name = "\\repeat" -> bitwiseLevel
(* Unary *)
| TCastE(_,_) -> 30
| TAddrOf(_) -> addrOfLevel
@@ -308,7 +308,7 @@ module Precedence = struct
| AInt _ | AStr _ | ACons _ -> 0
| ASizeOf _ | ASizeOfE _ -> 20
| AAlignOf _ | AAlignOfE _ -> 20
- | AUnOp (uo, _) ->
+ | AUnOp (uo, _) ->
getParenthLevel
(Cil.dummy_exp
(UnOp(uo, Cil.zero ~loc:Cil_datatype.Location.unknown, Cil.intType)))
@@ -385,7 +385,7 @@ let is_same_direction_rel dir op =
(* when pretty-printing relation chains, a < b && b' < c, it can happen that
b has a coercion and b' hasn't or vice-versa (bc c is an integer and a and
- b are ints for instance). We nevertheless want to
+ b are ints for instance). We nevertheless want to
pretty-print that as a < b < c. For that, we compare b and b' after having
removed any existing head coercion.
*)
@@ -474,11 +474,11 @@ class cil_printer () = object (self)
method private current_behavior = current_behavior
method private set_current_behavior b =
- assert (current_behavior = None);
+ assert (current_behavior = None);
current_behavior <- Some b
method private reset_current_behavior () =
- assert (current_behavior <> None);
+ assert (current_behavior <> None);
current_behavior <- None
val mutable has_annot = false
@@ -488,8 +488,8 @@ class cil_printer () = object (self)
method private push_stmt s = Stack.push s current_stmt
method private pop_stmt s =
- ignore (Stack.pop current_stmt);
- has_annot <- false;
+ ignore (Stack.pop current_stmt);
+ has_annot <- false;
s
method private current_stmt =
@@ -509,7 +509,7 @@ class cil_printer () = object (self)
(*fprintf fmt "/* %Lx */" i;*)
(** We must make sure to capture the type of the constant. For some
constants this is done with a suffix, for others with a cast
- prefix.*)
+ prefix.*)
let suffix = match ik with
| IUInt -> "U"
| ILong -> "L"
@@ -545,7 +545,7 @@ class cil_printer () = object (self)
| CChr(c) -> fprintf fmt "'%s'" (Escape.escape_char c)
| CReal(_, _, Some s) -> fprintf fmt "%s" s
| CReal(f, fsize, None) ->
- fprintf fmt "%a%s"
+ fprintf fmt "%a%s"
Floating_point.pretty f
(match fsize with
FFloat -> "f"
@@ -704,7 +704,7 @@ class cil_printer () = object (self)
true
else if contextprec == Precedence.bitwiseLevel then
(* quiet down some GCC warnings *)
- thisLevel == Precedence.additiveLevel
+ thisLevel == Precedence.additiveLevel
|| thisLevel == Precedence.comparativeLevel
else
false
@@ -801,7 +801,7 @@ class cil_printer () = object (self)
BinOp((PlusA|PlusPI|IndexPI),
{enode = Lval(lv')},
{enode=Const(CInt64(one,_,_))},_)
- when LvalStructEq.equal lv lv' && Integer.equal one Integer.one
+ when LvalStructEq.equal lv lv' && Integer.equal one Integer.one
&& not state.print_cil_as_is ->
fprintf fmt "%a ++%s"
(self#lval_prec Precedence.indexLevel) lv
@@ -849,13 +849,13 @@ class cil_printer () = object (self)
pp_call None (Cil.evar f) fmt args
| Local_init(vi, ConsInit(f, args, Plain_func), _) ->
Format.fprintf fmt "@[<2>%a =@ %a@]" self#vdecl vi
- (pp_call None (Cil.evar f)) args;
- (* In cabs2cil we have turned the call to builtin_va_arg into a
- three-argument call: the last argument is the address of the
- destination *)
+ (pp_call None (Cil.evar f)) args;
+ (* In cabs2cil we have turned the call to builtin_va_arg into a
+ three-argument call: the last argument is the address of the
+ destination *)
| Call(None, {enode = Lval(Var vi, NoOffset)},
[dest; {enode = SizeOf t}; adest], (l,_))
- when vi.vname = "__builtin_va_arg"
+ when vi.vname = "__builtin_va_arg"
&& not state.print_cil_as_is ->
let destlv = match (Cil.stripCasts adest).enode with
AddrOf destlv -> destlv
@@ -886,7 +886,7 @@ class cil_printer () = object (self)
(* In cabs2cil we have dropped the last argument in the call to
__builtin_next_arg. *)
| Call(res, {enode = Lval(Var vi, NoOffset)}, [ ], l)
- when vi.vname = "__builtin_next_arg"
+ when vi.vname = "__builtin_next_arg"
&& not state.print_cil_as_is ->
let last = self#getLastNamedArgument () in
self#instr fmt (Call(res,Cil.dummy_exp(Lval(Var vi,NoOffset)),[last],l))
@@ -976,11 +976,11 @@ class cil_printer () = object (self)
(* No need to output a final colon if there's no label. *)
if not lab_nil then
Pretty_utils.pp_list ~pre:"@;@[:" ~suf:"@]" ~sep:",@ "
- (fun fmt r ->
- match pickLabel !r.labels with
+ (fun fmt r ->
+ match pickLabel !r.labels with
| Some label -> Format.pp_print_string fmt label
| None ->
- Kernel.error "Cannot find label for target of asm goto: %a"
+ Kernel.error "Cannot find label for target of asm goto: %a"
(self#without_annot self#stmt) !r;
Format.pp_print_string fmt "__invalid_label")
fmt
@@ -990,9 +990,9 @@ class cil_printer () = object (self)
| Code_annot (annot, l) ->
has_annot <- true;
if logic_printer_enabled then begin
- self#line_directive ~forcefile:false fmt l;
+ self#line_directive ~forcefile:false fmt l;
Format.fprintf fmt "%t " (fun fmt -> self#pp_open_annotation fmt);
- self#code_annotation fmt annot ;
+ self#code_annotation fmt annot ;
Format.fprintf fmt "@ %t" (fun fmt -> self#pp_close_annotation fmt);
end
@@ -1045,8 +1045,8 @@ class cil_printer () = object (self)
method initinfo fmt io =
match io.init with
- | None -> fprintf fmt "{}"
- | Some i -> fprintf fmt "%a" self#init i
+ | None -> fprintf fmt "{}"
+ | Some i -> fprintf fmt "%a" self#init i
method fundec fmt fd = fprintf fmt "%a" self#varinfo fd.svar
@@ -1064,13 +1064,13 @@ class cil_printer () = object (self)
let was_ghost = is_ghost in
let display_ghost = s.ghost && not was_ghost in
if display_ghost then begin
- is_ghost <- true;
+ is_ghost <- true;
Format.fprintf fmt "%t %a "
(fun fmt -> self#pp_open_annotation fmt) self#pp_acsl_keyword "ghost"
end;
self#stmtkind s.sattr next fmt s.skind ;
if display_ghost then begin
- is_ghost <- false;
+ is_ghost <- false;
self#pp_close_annotation fmt
end
end;
@@ -1088,34 +1088,34 @@ class cil_printer () = object (self)
| _, _, _ :: _,_ | _, _ :: _, _, _ -> true
| _::_::_,[],[],Stmt_block s ->
not (Cil.has_extern_local_init blk) &&
- (self#stmt_has_annot s || s.labels <> [])
- (* Do not put braces around a Local_init statement if we are not
- in the appropriate block. This trumps the presence of a binding
- annotation (or a label at block level, in case of something like:
- { /* start of scoping block */
- //@ slicing pragma stmt;
- /* { */ /* start of non-scoping block
- int x = 42;
- x++;
- ...
- /* } */ /* end of non-scoping block
+ (self#stmt_has_annot s || s.labels <> [])
+ (* Do not put braces around a Local_init statement if we are not
+ in the appropriate block. This trumps the presence of a binding
+ annotation (or a label at block level, in case of something like:
+ { /* start of scoping block */
+ //@ slicing pragma stmt;
+ /* { */ /* start of non-scoping block
+ int x = 42;
x++;
- } /* end of scoping block */
+ ...
+ /* } */ /* end of non-scoping block
+ x++;
+ } /* end of scoping block */
In such case, the pretty-printer can't satisfy the scope of the
annotation and the scope of x at the same time. We favor x, which
gives us at least a correct, compilable, C code.
- *)
+ *)
| _::_::_,[],[],_ -> is_cfg_block ctxt
| [ { skind = Block b } as s' ], [], [], Stmt_block s ->
(b.bscoping ||
(not (Cil.has_extern_local_init b) && self#stmt_has_annot s))
&& self#require_braces ctxt b
&& not (self#require_braces (Stmt_block s') b)
- (* If b wants braces in current context but not in subcontext, put
- braces directly there. Otherwise, wait for children to do it. *)
+ (* If b wants braces in current context but not in subcontext, put
+ braces directly there. Otherwise, wait for children to do it. *)
| [ { skind = Block b } ], [], [], _ -> self#require_braces ctxt b
| [ { skind = UnspecifiedSequence s } ], [], [], _ ->
- self#require_braces ctxt (Cil.block_from_unspecified_sequence s)
+ self#require_braces ctxt (Cil.block_from_unspecified_sequence s)
| [_],[],[], Then_with_else -> self#block_has_dangling_else blk
| [ _ ], [], [], _ -> false
| [],[],[],_ -> false)
@@ -1130,18 +1130,18 @@ class cil_printer () = object (self)
method private block_is_function blk = match blk.bstmts with
| [ { skind = Instr (Call _) } ] -> true
| [ { skind = Instr (Local_init (_, ConsInit _, _)) } ] -> true
- (* NB: a block consisting solely of an initializer is pretty useless,
- but who knows? *)
+ (* NB: a block consisting solely of an initializer is pretty useless,
+ but who knows? *)
| [ { skind = Block blk } ] -> self#block_is_function blk
| _ -> false
method private block_has_dangling_else blk = match blk.bstmts with
- | [ { skind = If(_, { bstmts=[]; battrs=[] }, _, _)
- | If(_, {bstmts=[{skind=Goto _; labels=[]}]; battrs=[]}, _, _)
- | If(_, _, { bstmts=[]; battrs=[] }, _)
- | If(_, _, {bstmts=[{skind=Goto _; labels=[]}]; battrs=[]}, _) } ]
+ | [ { skind = If(_, { bstmts=[]; battrs=[] }, _, _)
+ | If(_, {bstmts=[{skind=Goto _; labels=[]}]; battrs=[]}, _, _)
+ | If(_, _, { bstmts=[]; battrs=[] }, _)
+ | If(_, _, {bstmts=[{skind=Goto _; labels=[]}]; battrs=[]}, _) } ]
-> true
- | [ { skind = Block blk | If(_, _, blk, _) } ] ->
+ | [ { skind = Block blk | If(_, _, blk, _) } ] ->
self#block_has_dangling_else blk
| _ -> false
@@ -1168,29 +1168,29 @@ class cil_printer () = object (self)
if braces && not inline then pp_print_space fmt ();
if blk.blocals <> [] && verbose then
fprintf fmt "@[/* Locals: %a */@]@ "
- (Pretty_utils.pp_list ~sep:",@ " self#varinfo) blk.blocals;
+ (Pretty_utils.pp_list ~sep:",@ " self#varinfo) blk.blocals;
if verbose && not blk.bscoping then fprintf fmt "/* non-scoping */@\n";
- if blk.battrs <> [] then
+ if blk.battrs <> [] then
(* [JS 2012/12/07] could directly call self#attributesGen whenever we are
- sure than it puts its printing material inside a box *)
+ sure than it puts its printing material inside a box *)
fprintf fmt "@[%a@]" (self#attributesGen true) blk.battrs;
let locals_decl = List.filter (fun v -> not v.vdefined) blk.blocals in
if locals_decl <> [] then
- Pretty_utils.pp_list ~pre:"@[<v>" ~sep:"@;" ~suf:"@]@ "
- self#vdecl_complete fmt locals_decl;
+ Pretty_utils.pp_list ~pre:"@[<v>" ~sep:"@;" ~suf:"@]@ "
+ self#vdecl_complete fmt locals_decl;
let rec iterblock ~cut fmt = function
| [] -> ()
| [ s ] ->
- fprintf fmt "";
- if cut && not inline && not braces then pp_print_cut fmt ();
- self#next_stmt Cil.invalidStmt fmt s
+ fprintf fmt "";
+ if cut && not inline && not braces then pp_print_cut fmt ();
+ self#next_stmt Cil.invalidStmt fmt s
| s_cur :: (s_next :: _ as tail) ->
- Format.fprintf fmt "%a@ %a"
- (self#next_stmt s_next) s_cur
- (iterblock ~cut:false) tail
+ Format.fprintf fmt "%a@ %a"
+ (self#next_stmt s_next) s_cur
+ (iterblock ~cut:false) tail
in
let stmts = blk.bstmts in
- if stmts = [] && not braces then fprintf fmt ";"
+ if stmts = [] && not braces then fprintf fmt ";"
else fprintf fmt "%a" (iterblock ~cut) stmts;
if braces then Format.fprintf fmt "@;<1 -2>}"
@@ -1212,14 +1212,14 @@ class cil_printer () = object (self)
| Some _ when (fst l).Filepath.pos_lnum <= 0 -> ()
(* Do not print lineComment if the same line as above *)
- | Some Line_comment_sparse when (fst l).Filepath.pos_lnum = lastLineNumber ->
+ | Some Line_comment_sparse when (fst l).Filepath.pos_lnum = lastLineNumber ->
()
| Some style ->
let directive = match style with
- | Line_comment | Line_comment_sparse -> "//#line"
- | Line_preprocessor_output when not (Cil.msvcMode ()) -> "#"
- | Line_preprocessor_output | Line_preprocessor_input -> "#line"
+ | Line_comment | Line_comment_sparse -> "//#line"
+ | Line_preprocessor_output when not (Cil.msvcMode ()) -> "#"
+ | Line_preprocessor_output | Line_preprocessor_input -> "#line"
in
let pos = fst l in
lastLineNumber <- pos.Filepath.pos_lnum;
@@ -1228,11 +1228,11 @@ class cil_printer () = object (self)
lastFileName <- pos.Filepath.pos_path;
Format.asprintf " \"%a\""
Datatype.Filepath.pretty pos.Filepath.pos_path
- end else
- ""
+ end else
+ ""
in
- fprintf fmt "@[@<0>\n@<0>%s@<0> @<0>%d@<0> @<0>%s@]@\n"
- directive (fst l).Filepath.pos_lnum filename
+ fprintf fmt "@[@<0>\n@<0>%s@<0> @<0>%d@<0> @<0>%s@]@\n"
+ directive (fst l).Filepath.pos_lnum filename
method stmtkind sattr (next: stmt) fmt = function
| UnspecifiedSequence seq ->
@@ -1247,19 +1247,19 @@ class cil_printer () = object (self)
if verbose ||
Kernel.is_debug_key_enabled Kernel.dkey_print_unspecified
then
- Format.fprintf fmt "@ /*effects: @[(%a) %a@ <-@ %a@]*/"
+ Format.fprintf fmt "@ /*effects: @[(%a) %a@ <-@ %a@]*/"
(Pretty_utils.pp_list ~sep:",@ " self#lval) modifies
- (Pretty_utils.pp_list ~sep:",@ " self#lval) writes
- (Pretty_utils.pp_list ~sep:",@ " self#lval) reads
+ (Pretty_utils.pp_list ~sep:",@ " self#lval) writes
+ (Pretty_utils.pp_list ~sep:",@ " self#lval) reads
in
let rec iterblock fmt = function
| [] -> ()
| [ srw ] ->
- print_stmt (self#next_stmt Cil.invalidStmt) fmt srw
+ print_stmt (self#next_stmt Cil.invalidStmt) fmt srw
| srw_first :: ((s_next,_,_,_,_) :: _ as tail) ->
print_stmt (self#next_stmt s_next) fmt srw_first ;
pp_print_space fmt ();
- iterblock fmt tail
+ iterblock fmt tail
in
fprintf fmt "%t%a%t"
(fun fmt ->
@@ -1286,12 +1286,12 @@ class cil_printer () = object (self)
match pickLabel !sref.labels with
| Some lbl ->
fprintf fmt "@[%a%a %s;@]"
- (fun fmt -> self#line_directive fmt) l
+ (fun fmt -> self#line_directive fmt) l
self#pp_keyword "goto"
- lbl
+ lbl
| None ->
- Kernel.error "Cannot find label for target of goto: %a"
- (self#without_annot self#stmt) !sref;
+ Kernel.error "Cannot find label for target of goto: %a"
+ (self#without_annot self#stmt) !sref;
fprintf fmt "@[%a@ __invalid_label;@]" self#pp_keyword "goto"
end
@@ -1305,10 +1305,10 @@ class cil_printer () = object (self)
(fun fmt -> self#line_directive fmt) l
self#pp_keyword "continue"
- | Instr i ->
+ | Instr i ->
self#instr fmt i
- | If(be,t,{bstmts=[];battrs=[]},l)
+ | If(be,t,{bstmts=[];battrs=[]},l)
when not state.print_cil_as_is ->
fprintf fmt "@[<hv>%a@[<v 2>%a (%a) %a@]@]"
(fun fmt -> self#line_directive ~forcefile:false fmt) l
@@ -1324,7 +1324,7 @@ class cil_printer () = object (self)
self#exp be
(self#unboxed_block Other) t
- | If(be,{bstmts=[];battrs=[]},e,l)
+ | If(be,{bstmts=[];battrs=[]},e,l)
when not state.print_cil_as_is ->
fprintf fmt "@[<hv>%a@[<v 2>%a (%a) %a@]@]"
(fun fmt -> self#line_directive ~forcefile:false fmt) l
@@ -1348,7 +1348,7 @@ class cil_printer () = object (self)
|| not (self#inline_block Then_with_else t)
|| not (self#inline_block Other e)
|| (* call to a function in both branches (for GUI' status bullets) *)
- (force_brace && self#block_is_function t && self#block_is_function e)
+ (force_brace && self#block_is_function t && self#block_is_function e)
in
fprintf fmt "@[<v 2>%a (%a) %a@]"
self#pp_keyword "if"
@@ -1381,19 +1381,19 @@ class cil_printer () = object (self)
in
((* Maybe the first thing is a conditional. Turn it into a WHILE *)
try
- let rec skipEmpty = function
- | [] -> []
+ let rec skipEmpty = function
+ | [] -> []
| { skind = Instr (Skip _) } as h :: rest
- when self#may_be_skipped h-> skipEmpty rest
- | x -> x
- in
- let term, bodystmts =
- (* Bill McCloskey: Do not remove the If if it has labels *)
- match skipEmpty b.bstmts with
- | { skind = If(e,tb,fb,_) } as to_skip :: rest
- when not state.print_cil_as_is
- && self#may_be_skipped to_skip ->
- (match skipEmpty tb.bstmts, skipEmpty fb.bstmts with
+ when self#may_be_skipped h-> skipEmpty rest
+ | x -> x
+ in
+ let term, bodystmts =
+ (* Bill McCloskey: Do not remove the If if it has labels *)
+ match skipEmpty b.bstmts with
+ | { skind = If(e,tb,fb,_) } as to_skip :: rest
+ when not state.print_cil_as_is
+ && self#may_be_skipped to_skip ->
+ (match skipEmpty tb.bstmts, skipEmpty fb.bstmts with
| [], [ { skind = Break _ } as s ] when self#may_be_skipped s ->
e, rest
| [], [ { skind = Goto(sref, _) } as s ]
@@ -1401,31 +1401,31 @@ class cil_printer () = object (self)
&& Cil_datatype.Stmt.equal !sref next ->
e, rest
| [ { skind = Break _ } as s ], [] when self#may_be_skipped s ->
- Cil.dummy_exp (UnOp(LNot, e, Cil.intType)), rest
+ Cil.dummy_exp (UnOp(LNot, e, Cil.intType)), rest
| [ { skind = Goto(sref, _) } as s ], []
when self#may_be_skipped s
&& Cil_datatype.Stmt.equal !sref next ->
Cil.dummy_exp (UnOp(LNot, e, Cil.intType)), rest
- | _ -> raise Not_found)
- | _ -> raise Not_found
- in
- let b = match skipEmpty bodystmts with
- [{ skind=Block b} as s ] when self#may_be_skipped s -> b
- | _ -> { b with bstmts = bodystmts }
- in
- Format.fprintf fmt "%a@[<v 2>%a (%a) %t%a@]"
- (fun fmt -> self#line_directive fmt) l
+ | _ -> raise Not_found)
+ | _ -> raise Not_found
+ in
+ let b = match skipEmpty bodystmts with
+ [{ skind=Block b} as s ] when self#may_be_skipped s -> b
+ | _ -> { b with bstmts = bodystmts }
+ in
+ Format.fprintf fmt "%a@[<v 2>%a (%a) %t%a@]"
+ (fun fmt -> self#line_directive fmt) l
self#pp_keyword "while"
- self#exp term
- pp_sattr
- (self#unboxed_block Other) b;
+ self#exp term
+ pp_sattr
+ (self#unboxed_block Other) b;
with Not_found ->
- Format.fprintf fmt "%a@[<v 2>%a (1) %t%a@]"
- (fun fmt -> self#line_directive fmt) l
+ Format.fprintf fmt "%a@[<v 2>%a (1) %t%a@]"
+ (fun fmt -> self#line_directive fmt) l
self#pp_keyword "while"
pp_sattr
- (self#unboxed_block Other) b);
+ (self#unboxed_block Other) b);
Format.pp_close_box fmt ()
| Block b ->
@@ -1660,9 +1660,9 @@ class cil_printer () = object (self)
method fieldinfo fmt fi =
fprintf fmt "%a %s%a;"
(self#typ
- (Some (fun fmt ->
- if fi.fname <> Cil.missingFieldName then
- self#varname fmt fi.fname)))
+ (Some (fun fmt ->
+ if fi.fname <> Cil.missingFieldName then
+ self#varname fmt fi.fname)))
fi.ftype
(match fi.fbitfield with
| None -> ""
@@ -1728,9 +1728,9 @@ class cil_printer () = object (self)
| ILong -> "long"
| IULong -> "unsigned long"
| ILongLong ->
- if Cil.msvcMode () then "__int64" else "long long"
+ if Cil.msvcMode () then "__int64" else "long long"
| IULongLong ->
- if Cil.msvcMode () then "unsigned __int64" else "unsigned long long"
+ if Cil.msvcMode () then "unsigned __int64" else "unsigned long long"
)
method typ ?fundecl nameOpt
@@ -1743,8 +1743,8 @@ class cil_printer () = object (self)
match nameOpt with
| None when not state.print_cil_input && not (Cil.msvcMode ()) -> ()
(* Cannot print the attributes in this case because gcc does not like them
- here, except if we are printing for CIL, or for MSVC. In fact, for
- MSVC we MUST print attributes such as __stdcall *)
+ here, except if we are printing for CIL, or for MSVC. In fact, for
+ MSVC we MUST print attributes such as __stdcall *)
(* if pa = nil then nil else text "/*" ++ pa ++ text "*/"*)
| _ -> self#attributes fmt a
in
@@ -1759,18 +1759,18 @@ class cil_printer () = object (self)
| TComp (comp, _, a) -> (* A reference to a struct *)
fprintf fmt
- "%a %a%a%a"
- self#pp_keyword (if comp.cstruct then "struct" else "union")
- self#varname comp.cname
- self#attributes a
- pname true
+ "%a %a%a%a"
+ self#pp_keyword (if comp.cstruct then "struct" else "union")
+ self#varname comp.cname
+ self#attributes a
+ pname true
| TEnum (enum, a) ->
fprintf fmt "%a %a%a%a"
self#pp_keyword "enum"
self#varname enum.ename
- self#attributes a
- pname true
+ self#attributes a
+ pname true
| TPtr (bt, a) ->
(* Parenthesize the ( * attr name) if a pointer to a function or an
@@ -1778,28 +1778,28 @@ class cil_printer () = object (self)
* before the pointer constructor "(__stdcall *f)". We push them into
* the parenthesis. *)
let (paren: (formatter -> unit) option), (bt': typ) =
- match bt with
- | TFun(rt, args, isva, fa) when Cil.msvcMode () ->
- let an, af', at = Cil.partitionAttributes ~default:Cil.AttrType fa in
- (* We take the af' and we put them into the parentheses *)
- Some
- (fun fmt ->
- fprintf fmt
- "(%a"
- printAttributes af'),
- TFun(rt, args, isva, Cil.addAttributes an at)
- | TFun _ | TArray _ -> (Some (fun fmt -> fprintf fmt "(")), bt
- | _ -> None, bt
+ match bt with
+ | TFun(rt, args, isva, fa) when Cil.msvcMode () ->
+ let an, af', at = Cil.partitionAttributes ~default:Cil.AttrType fa in
+ (* We take the af' and we put them into the parentheses *)
+ Some
+ (fun fmt ->
+ fprintf fmt
+ "(%a"
+ printAttributes af'),
+ TFun(rt, args, isva, Cil.addAttributes an at)
+ | TFun _ | TArray _ -> (Some (fun fmt -> fprintf fmt "(")), bt
+ | _ -> None, bt
in
- let name' =
- fun fmt -> fprintf fmt "*%a%a" printAttributes a pname (a <> [])
+ let name' =
+ fun fmt -> fprintf fmt "*%a%a" printAttributes a pname (a <> [])
in
let name'' =
- fun fmt ->
- (* Put the parenthesis *)
- match paren with
- | Some p -> fprintf fmt "%t%t)" p name'
- | None -> fprintf fmt "%t" name'
+ fun fmt ->
+ (* Put the parenthesis *)
+ match paren with
+ | Some p -> fprintf fmt "%t%t)" p name'
+ | None -> fprintf fmt "%t" name'
in
self#typ (Some name'') fmt bt'
@@ -1809,31 +1809,31 @@ class cil_printer () = object (self)
result if the qualifier is misplaced. *)
let atts_elem, a = Cil.splitArrayAttributes a in
if atts_elem != [] then
- Kernel.failure ~current:true
- "Found some incorrect attributes for array (%a). Please report."
- self#attributes atts_elem;
+ Kernel.failure ~current:true
+ "Found some incorrect attributes for array (%a). Please report."
+ self#attributes atts_elem;
let name' fmt =
- if a = [] then pname fmt false
+ if a = [] then pname fmt false
else if nameOpt = None then
- printAttributes fmt a
- else
- fprintf fmt "(%a%a)" printAttributes a pname true
+ printAttributes fmt a
+ else
+ fprintf fmt "(%a%a)" printAttributes a pname true
in
self#typ
- (Some (fun fmt ->
- fprintf fmt "%t[%t]"
- name'
- (fun fmt ->
- match lo with
- | None -> ()
- | Some e -> self#exp fmt e)
- ))
- fmt
- elemt
+ (Some (fun fmt ->
+ fprintf fmt "%t[%t]"
+ name'
+ (fun fmt ->
+ match lo with
+ | None -> ()
+ | Some e -> self#exp fmt e)
+ ))
+ fmt
+ elemt
| TFun (restyp, args, isvararg, a) ->
let name' fmt =
- if a = [] then pname fmt false
+ if a = [] then pname fmt false
else if nameOpt = None then printAttributes fmt a
else fprintf fmt "(%a%a)" printAttributes a pname (a <> [])
in
@@ -1869,14 +1869,14 @@ class cil_printer () = object (self)
| TNamed (t, a) ->
fprintf fmt "%a%a%a"
- self#varname t.tname
- self#attributes a
- pname true
+ self#varname t.tname
+ self#attributes a
+ pname true
| TBuiltin_va_list a ->
fprintf fmt "__builtin_va_list%a%a"
- self#attributes a
- pname true
+ self#attributes a
+ pname true
(**** PRINTING ATTRIBUTES *********)
method attributes fmt a = self#attributesGen false fmt a
@@ -1893,36 +1893,36 @@ class cil_printer () = object (self)
| "thread", [] when not (Cil.msvcMode ()) -> fprintf fmt "__thread"; false
| "volatile", [] -> self#pp_keyword fmt "volatile"; false
| "restrict", [] -> fprintf fmt "__restrict"; false
- | "missingproto", [] ->
- if self#display_comment () then fprintf fmt "/* missing proto */";
+ | "missingproto", [] ->
+ if self#display_comment () then fprintf fmt "/* missing proto */";
false
- | "cdecl", [] when Cil.msvcMode () ->
+ | "cdecl", [] when Cil.msvcMode () ->
fprintf fmt "__cdecl"; false
| "stdcall", [] when Cil.msvcMode () ->
fprintf fmt "__stdcall"; false
- | "fastcall", [] when Cil.msvcMode () ->
+ | "fastcall", [] when Cil.msvcMode () ->
fprintf fmt "__fastcall"; false
| "declspec", args when Cil.msvcMode () ->
fprintf fmt "__declspec(%a)"
- (Pretty_utils.pp_list ~sep:"" self#attrparam) args;
+ (Pretty_utils.pp_list ~sep:"" self#attrparam) args;
false
- | "w64", [] when Cil.msvcMode () ->
+ | "w64", [] when Cil.msvcMode () ->
fprintf fmt "__w64"; false
| "asm", args ->
fprintf fmt "__asm__(%a)"
- (Pretty_utils.pp_list ~sep:"" self#attrparam) args;
+ (Pretty_utils.pp_list ~sep:"" self#attrparam) args;
false
(* we suppress printing mode(__si__) because it triggers an
- internal compiler error in all current gcc versions
+ internal compiler error in all current gcc versions
sm: I've now encountered a problem with mode(__hi__)...
I don't know what's going on, but let's try disabling all "mode". *)
| "mode", [ACons(tag,[])] ->
if self#display_comment () then fprintf fmt "/* mode(%s) */" tag;
false
- (* sm: also suppress "format" because we seem to print it in
+ (* sm: also suppress "format" because we seem to print it in
a way gcc does not like *)
- | "format", _ ->
+ | "format", _ ->
if self#display_comment () then fprintf fmt "/* format attribute */";
false
@@ -1931,17 +1931,17 @@ class cil_printer () = object (self)
(* sm: here's another one I don't want to see gcc warnings about.. *)
| "mayPointToStack", _ when not state.print_cil_input ->
(* [matth: may be inside another comment.]
- -> text "/*mayPointToStack*/", false *)
+ -> text "/*mayPointToStack*/", false *)
false
| "arraylen", [a] ->
if self#display_comment () then fprintf fmt "/*[%a]*/" self#attrparam a;
false
- | "static",_ ->
+ | "static",_ ->
if self#display_comment () then fprintf fmt "/* static */"; false
| "", _ ->
fprintf fmt "%a "
- (Pretty_utils.pp_list ~sep:" " self#attrparam) args;
+ (Pretty_utils.pp_list ~sep:" " self#attrparam) args;
true
| s, _ when
s = Cil.bitfield_attribute_name &&
@@ -1951,14 +1951,14 @@ class cil_printer () = object (self)
| _ -> (* This is the default case *)
(* Add underscores to the name *)
let an' =
- if Cil.msvcMode () then "__" ^ an else "__" ^ an ^ "__"
+ if Cil.msvcMode () then "__" ^ an else "__" ^ an ^ "__"
in
(match args with
| [] -> fprintf fmt "%s" an'
| _ :: _ ->
- fprintf fmt "%s(%a)"
- an'
- (Pretty_utils.pp_list ~sep:"," self#attrparam) args);
+ fprintf fmt "%s(%a)"
+ an'
+ (Pretty_utils.pp_list ~sep:"," self#attrparam) args);
true)
| AttrAnnot s ->
fprintf fmt "%s" (Cil.mkAttrAnnot s); false
@@ -1967,13 +1967,13 @@ class cil_printer () = object (self)
let thisLevel = Precedence.getParenthLevelAttrParam a in
let needParens =
if thisLevel >= contextprec then
- true
+ true
else if contextprec == Precedence.bitwiseLevel then
- (* quiet down some GCC warnings *)
- thisLevel == Precedence.additiveLevel
- || thisLevel == Precedence.comparativeLevel
+ (* quiet down some GCC warnings *)
+ thisLevel == Precedence.additiveLevel
+ || thisLevel == Precedence.comparativeLevel
else
- false
+ false
in
if needParens then fprintf fmt "(%a)" self#attrparam a
else self#attrparam fmt a
@@ -1991,8 +1991,8 @@ class cil_printer () = object (self)
| ACons("__fc_float", [AStr s]) -> pp_print_string fmt s
| ACons(s,al) ->
fprintf fmt "%s(%a)"
- s
- (Pretty_utils.pp_list ~sep:"" self#attrparam) al
+ s
+ (Pretty_utils.pp_list ~sep:"" self#attrparam) al
| ASizeOfE a ->
fprintf fmt "%a(%a)"
self#pp_keyword "sizeof"
@@ -2007,9 +2007,9 @@ class cil_printer () = object (self)
fprintf fmt "%a %a" self#unop u (self#attribute_prec level) a1
| ABinOp(b,a1,a2) ->
fprintf fmt "@[(%a)%a@ (%a) @]"
- (self#attribute_prec level) a1
- self#binop b
- (self#attribute_prec level) a2
+ (self#attribute_prec level) a1
+ self#binop b
+ (self#attribute_prec level) a2
| ADot (ap, s) ->
fprintf fmt "%a.%s" self#attrparam ap s
| AStar a1 ->
@@ -2020,9 +2020,9 @@ class cil_printer () = object (self)
fprintf fmt "%a[%a]" self#attrparam a1 self#attrparam a2
| AQuestion (a1, a2, a3) ->
fprintf fmt "%a ? %a : %a"
- self#attrparam a1
- self#attrparam a2
- self#attrparam a3
+ self#attrparam a1
+ self#attrparam a2
+ self#attrparam a3
(* A general way of printing lists of attributes *)
method private attributesGen (block: bool) fmt (a: attributes) =
@@ -2075,13 +2075,13 @@ class cil_printer () = object (self)
fprintf fmt "L";
List.iter
(fun elt ->
- if (elt >= Int64.zero &&
- elt <= (Int64.of_int 255)) then
- fprintf fmt "%S"
- (Escape.escape_char (Char.chr (Int64.to_int elt)))
- else
- fprintf fmt "\"\\x%LX\"" elt;
- fprintf fmt "@ ")
+ if (elt >= Int64.zero &&
+ elt <= (Int64.of_int 255)) then
+ fprintf fmt "%S"
+ (Escape.escape_char (Char.chr (Int64.to_int elt)))
+ else
+ fprintf fmt "\"\\x%LX\"" elt;
+ fprintf fmt "@ ")
s;
(* we cannot print L"\xabcd" "feedme" as L"\xabcdfeedme" -- the former
has 7 wide characters and the later has 3. *)
@@ -2098,31 +2098,31 @@ class cil_printer () = object (self)
function
| Ctype typ -> self#typ name fmt typ
| Linteger ->
- let res =
- if Kernel.Unicode.get () then Utf8_logic.integer else "integer"
+ let res =
+ if Kernel.Unicode.get () then Utf8_logic.integer else "integer"
in
Format.fprintf fmt "%s%t" res pname
| Lreal ->
- let res =
- if Kernel.Unicode.get () then Utf8_logic.real else "real"
+ let res =
+ if Kernel.Unicode.get () then Utf8_logic.real else "real"
in
Format.fprintf fmt "%s%t" res pname
| Ltype ({ lt_name = name},[]) when name = Utf8_logic.boolean->
- let res =
- if Kernel.Unicode.get () then Utf8_logic.boolean else "boolean"
+ let res =
+ if Kernel.Unicode.get () then Utf8_logic.boolean else "boolean"
in
Format.fprintf fmt "%s%t" res pname
| Ltype (s,l) ->
fprintf fmt "%a%a%t" self#logic_type_info s
- ((* the space avoids the issue of list<list<int>> where the double >
- would be read as a shift. It could be optimized away in most of
- the cases. *)
- Pretty_utils.pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>@ "
- (self#logic_type None)) l pname
+ ((* the space avoids the issue of list<list<int>> where the double >
+ would be read as a shift. It could be optimized away in most of
+ the cases. *)
+ Pretty_utils.pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>@ "
+ (self#logic_type None)) l pname
| Larrow (args,rt) ->
fprintf fmt "@[@[<2>{@ %a@]}@]%a%t"
- (Pretty_utils.pp_list ~sep:",@ " (self#logic_type None)) args
- (self#logic_type None) rt pname
+ (Pretty_utils.pp_list ~sep:",@ " (self#logic_type None)) args
+ (self#logic_type None) rt pname
| Lvar s -> fprintf fmt "%a%t" self#varname s pname
method private name fmt s =
@@ -2133,13 +2133,13 @@ class cil_printer () = object (self)
let thisLevel = Precedence.getParenthLevelLogic e.term_node in
let needParens =
if thisLevel >= contextprec then
- true
+ true
else if contextprec == Precedence.bitwiseLevel then
- (* quiet down some GCC warnings *)
- thisLevel == Precedence.additiveLevel
- || thisLevel == Precedence.comparativeLevel
+ (* quiet down some GCC warnings *)
+ thisLevel == Precedence.additiveLevel
+ || thisLevel == Precedence.comparativeLevel
else
- false
+ false
in
if needParens then fprintf fmt "@[<hov 2>(%a)@]" self#term e
else self#term fmt e
@@ -2151,11 +2151,11 @@ class cil_printer () = object (self)
if debug then
fprintf fmt "/*(type:%a */" (self#logic_type None) t.term_type;
begin match t.term_name with
- | [] -> self#term_node fmt t
- | _ :: _ ->
- fprintf fmt "(@[%a:@ %a@])"
- (Pretty_utils.pp_list ~sep:":@ " self#name) t.term_name
- self#term_node t
+ | [] -> self#term_node fmt t
+ | _ :: _ ->
+ fprintf fmt "(@[%a:@ %a@])"
+ (Pretty_utils.pp_list ~sep:":@ " self#name) t.term_name
+ self#term_node t
end;
if debug then fprintf fmt "/*)*/"
@@ -2246,7 +2246,7 @@ class cil_printer () = object (self)
~sep:",@ " ~pre:"@[<hov>" ~suf:"@]@;" self#term_node) l
| _ ->
fprintf fmt "%a%a" self#varname ci.ctor_name
- (Pretty_utils.pp_list ~pre:"(@[" ~suf:"@])" ~sep:",@ " self#term)
+ (Pretty_utils.pp_list ~pre:"(@[" ~suf:"@])" ~sep:",@ " self#term)
args)
| TLval lv -> fprintf fmt "%a" (self#term_lval_prec current_level) lv
| TSizeOf t ->
@@ -2269,8 +2269,8 @@ class cil_printer () = object (self)
(self#term_prec current_level) r
| TCastE (ty,e) ->
fprintf fmt "(%a)%a" (self#typ None) ty
- (self#term_prec current_level) e
- | TAddrOf lv ->
+ (self#term_prec current_level) e
+ | TAddrOf lv ->
fprintf fmt "&%a" (self#term_lval_prec Precedence.addrOfLevel) lv
| TStartOf lv -> fprintf fmt "(%a)%a"
(self#logic_type None) t.term_type
@@ -2280,121 +2280,121 @@ class cil_printer () = object (self)
| Tapp ({ l_var_info },[],[e1; e2])
when l_var_info.lv_name = "\\concat" && not state.print_cil_as_is ->
fprintf fmt "%a ^ %a"
- (self#term_prec current_level) e1
- (self#term_prec current_level) e2
+ (self#term_prec current_level) e1
+ (self#term_prec current_level) e2
| Tapp ({ l_var_info },[],[e1;e2])
- when l_var_info.lv_name = "\\repeat" && not state.print_cil_as_is ->
+ when l_var_info.lv_name = "\\repeat" && not state.print_cil_as_is ->
fprintf fmt "%a *^ %a"
(self#term_prec current_level) e1
(self#term_prec current_level) e2
- | Tapp (f, labels, tl) ->
+ | Tapp (f, labels, tl) ->
fprintf fmt "%a%a%a"
- self#logic_info f
- self#labels labels
- (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ " self#term) tl
+ self#logic_info f
+ self#labels labels
+ (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ " self#term) tl
| Tif (cond,th,el) ->
fprintf fmt "@[<2>%a?@;%a:@;%a@]"
- (self#term_prec current_level) cond
- (self#term_prec current_level) th
- (self#term_prec current_level) el
- | Tat (t,lab) ->
- let old_label = current_label in
- current_label <- lab;
- if Cil_datatype.Logic_label.equal lab Logic_const.old_label then
- fprintf fmt "@[%a(@[%a@])@]" self#pp_acsl_keyword "\\old" self#term t
- else
- fprintf fmt "@[%a(@[@[%a@],@,@[%a@]@])@]"
- self#pp_acsl_keyword "\\at" self#term t self#logic_label lab;
- current_label <- old_label
- | Toffset (l,t) ->
- fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\offset"
- self#labels [l] self#term t
- | Tbase_addr (l,t) ->
- fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\base_addr"
- self#labels [l] self#term t
- | Tblock_length (l,t) ->
- fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\block_length"
- self#labels [l] self#term t
- | Tnull -> self#pp_acsl_keyword fmt "\\null"
- | TCoerce (e,ty) ->
- fprintf fmt "%a@ :>@ %a"
- (self#term_prec current_level) e (self#typ None) ty
- | TCoerceE (e,ce) ->
- fprintf fmt "%a :> %a"
- (self#term_prec current_level) e (self#term_prec current_level) ce
- | TUpdate (t,toff,v) ->
- fprintf fmt "{%a %a %a = %a}"
- self#term t
- self#pp_acsl_keyword "\\with"
- self#term_offset toff
- self#term v
- | Tlambda(prms,expr) ->
- fprintf fmt "@[<2>%a@ %a;@ %a@]"
- self#pp_acsl_keyword "\\lambda"
- self#quantifiers prms (self#term_prec current_level) expr
- | Ttypeof t ->
- fprintf fmt "%a(%a)" self#pp_acsl_keyword "\\typeof" self#term t
- | Ttype ty ->
- fprintf fmt "%a(%a)" self#pp_acsl_keyword "\\type" (self#typ None) ty
- | Tunion l
- when ((List.for_all (fun t -> not(Logic_const.is_set_type t.term_type)) l)
- && (not state.print_cil_as_is)) ->
- fprintf fmt "{%a}" (Pretty_utils.pp_list ~sep:",@ " self#term) l
- | Tunion locs ->
- fprintf fmt "@[<hov 2>%a(@,%a)@]"
- self#pp_acsl_keyword "\\union"
- (Pretty_utils.pp_list ~sep:",@ " self#term) locs
- | Tinter locs ->
- fprintf fmt "@[<hov 2>%a(@,%a)@]"
- self#pp_acsl_keyword "\\inter"
- (Pretty_utils.pp_list ~sep:",@ " self#term) locs
- | Tempty_set -> self#pp_acsl_keyword fmt "\\empty"
- | Tcomprehension(lv,quant,pred) ->
- fprintf fmt "{@[%a@ |@ %a%a@]}"
- self#term lv self#quantifiers quant
- (Pretty_utils.pp_opt
- (fun fmt p -> fprintf fmt ";@ %a" self#predicate p))
- pred
- | Trange(low,high) ->
- let pp_term = self#term_prec current_level in
- fprintf fmt "@[%a..%a@]"
- (Pretty_utils.pp_opt
- (fun fmt v -> Format.fprintf fmt "%a " pp_term v)) low
- (Pretty_utils.pp_opt
- (fun fmt v -> Format.fprintf fmt "@ %a" pp_term v)) high;
- | Tlet(def,body) ->
- assert
- (Kernel.verify (def.l_labels = [])
- "invalid logic construction: local definition with label");
- assert
- (Kernel.verify (def.l_tparams = [])
- "invalid logic construction: polymorphic local definition");
- let v = def.l_var_info in
- let args = def.l_profile in
- let pp_defn = match def.l_body with
- | LBterm t -> fun fmt -> self#term fmt t
- | LBpred p -> fun fmt -> self#predicate fmt p
- | LBnone
- | LBreads _ | LBinductive _ ->
- Kernel.fatal "invalid logic local definition"
- in
- fprintf fmt "@[%a@ %a@ =@ %t%t;@ %a@]"
- self#pp_acsl_keyword "\\let"
- self#logic_var v
- (fun fmt -> if args <> [] then
- fprintf fmt "@[<2>%a@ %a;@]@ "
- self#pp_acsl_keyword "\\lambda"
- self#quantifiers args)
- pp_defn
- (self#term_prec current_level) body
- | TLogic_coerce(ty,t) ->
- let debug =
- Kernel.is_debug_key_enabled Kernel.dkey_print_logic_coercions
- in
- if debug then
- fprintf fmt "/* (coercion to:%a */" (self#logic_type None) ty;
- self#term_prec current_level fmt t;
- if debug then fprintf fmt "/* ) */"
+ (self#term_prec current_level) cond
+ (self#term_prec current_level) th
+ (self#term_prec current_level) el
+ | Tat (t,lab) ->
+ let old_label = current_label in
+ current_label <- lab;
+ if Cil_datatype.Logic_label.equal lab Logic_const.old_label then
+ fprintf fmt "@[%a(@[%a@])@]" self#pp_acsl_keyword "\\old" self#term t
+ else
+ fprintf fmt "@[%a(@[@[%a@],@,@[%a@]@])@]"
+ self#pp_acsl_keyword "\\at" self#term t self#logic_label lab;
+ current_label <- old_label
+ | Toffset (l,t) ->
+ fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\offset"
+ self#labels [l] self#term t
+ | Tbase_addr (l,t) ->
+ fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\base_addr"
+ self#labels [l] self#term t
+ | Tblock_length (l,t) ->
+ fprintf fmt "%a%a(%a)" self#pp_acsl_keyword "\\block_length"
+ self#labels [l] self#term t
+ | Tnull -> self#pp_acsl_keyword fmt "\\null"
+ | TCoerce (e,ty) ->
+ fprintf fmt "%a@ :>@ %a"
+ (self#term_prec current_level) e (self#typ None) ty
+ | TCoerceE (e,ce) ->
+ fprintf fmt "%a :> %a"
+ (self#term_prec current_level) e (self#term_prec current_level) ce
+ | TUpdate (t,toff,v) ->
+ fprintf fmt "{%a %a %a = %a}"
+ self#term t
+ self#pp_acsl_keyword "\\with"
+ self#term_offset toff
+ self#term v
+ | Tlambda(prms,expr) ->
+ fprintf fmt "@[<2>%a@ %a;@ %a@]"
+ self#pp_acsl_keyword "\\lambda"
+ self#quantifiers prms (self#term_prec current_level) expr
+ | Ttypeof t ->
+ fprintf fmt "%a(%a)" self#pp_acsl_keyword "\\typeof" self#term t
+ | Ttype ty ->
+ fprintf fmt "%a(%a)" self#pp_acsl_keyword "\\type" (self#typ None) ty
+ | Tunion l
+ when ((List.for_all (fun t -> not(Logic_const.is_set_type t.term_type)) l)
+ && (not state.print_cil_as_is)) ->
+ fprintf fmt "{%a}" (Pretty_utils.pp_list ~sep:",@ " self#term) l
+ | Tunion locs ->
+ fprintf fmt "@[<hov 2>%a(@,%a)@]"
+ self#pp_acsl_keyword "\\union"
+ (Pretty_utils.pp_list ~sep:",@ " self#term) locs
+ | Tinter locs ->
+ fprintf fmt "@[<hov 2>%a(@,%a)@]"
+ self#pp_acsl_keyword "\\inter"
+ (Pretty_utils.pp_list ~sep:",@ " self#term) locs
+ | Tempty_set -> self#pp_acsl_keyword fmt "\\empty"
+ | Tcomprehension(lv,quant,pred) ->
+ fprintf fmt "{@[%a@ |@ %a%a@]}"
+ self#term lv self#quantifiers quant
+ (Pretty_utils.pp_opt
+ (fun fmt p -> fprintf fmt ";@ %a" self#predicate p))
+ pred
+ | Trange(low,high) ->
+ let pp_term = self#term_prec current_level in
+ fprintf fmt "@[%a..%a@]"
+ (Pretty_utils.pp_opt
+ (fun fmt v -> Format.fprintf fmt "%a " pp_term v)) low
+ (Pretty_utils.pp_opt
+ (fun fmt v -> Format.fprintf fmt "@ %a" pp_term v)) high;
+ | Tlet(def,body) ->
+ assert
+ (Kernel.verify (def.l_labels = [])
+ "invalid logic construction: local definition with label");
+ assert
+ (Kernel.verify (def.l_tparams = [])
+ "invalid logic construction: polymorphic local definition");
+ let v = def.l_var_info in
+ let args = def.l_profile in
+ let pp_defn = match def.l_body with
+ | LBterm t -> fun fmt -> self#term fmt t
+ | LBpred p -> fun fmt -> self#predicate fmt p
+ | LBnone
+ | LBreads _ | LBinductive _ ->
+ Kernel.fatal "invalid logic local definition"
+ in
+ fprintf fmt "@[%a@ %a@ =@ %t%t;@ %a@]"
+ self#pp_acsl_keyword "\\let"
+ self#logic_var v
+ (fun fmt -> if args <> [] then
+ fprintf fmt "@[<2>%a@ %a;@]@ "
+ self#pp_acsl_keyword "\\lambda"
+ self#quantifiers args)
+ pp_defn
+ (self#term_prec current_level) body
+ | TLogic_coerce(ty,t) ->
+ let debug =
+ Kernel.is_debug_key_enabled Kernel.dkey_print_logic_coercions
+ in
+ if debug then
+ fprintf fmt "/* (coercion to:%a */" (self#logic_type None) ty;
+ self#term_prec current_level fmt t;
+ if debug then fprintf fmt "/* ) */"
method private term_lval_prec contextprec fmt lv =
if Precedence.getParenthLevelLogic (TLval lv) > contextprec then
@@ -2438,8 +2438,8 @@ class cil_printer () = object (self)
method quantifiers fmt l =
Pretty_utils.pp_list ~sep:",@ "
(fun fmt lv ->
- let pvar fmt = self#logic_var fmt lv in
- self#logic_type (Some pvar) fmt lv.lv_type)
+ let pvar fmt = self#logic_var fmt lv in
+ self#logic_type (Some pvar) fmt lv.lv_type)
fmt l
method private pred_prec fmt (contextprec,p) =
@@ -2453,13 +2453,13 @@ class cil_printer () = object (self)
| [] -> self#pred_prec fmt (parenth,content)
| _ :: _ ->
if parenth = Precedence.upperLevel then
- fprintf fmt "@[<hv 2>%a:@ %a@]"
- (Pretty_utils.pp_list ~sep:":@ " self#name) names
- self#pred_prec (Precedence.upperLevel, content)
+ fprintf fmt "@[<hv 2>%a:@ %a@]"
+ (Pretty_utils.pp_list ~sep:":@ " self#name) names
+ self#pred_prec (Precedence.upperLevel, content)
else
- fprintf fmt "(@[<hv 2>%a:@ %a@])"
- (Pretty_utils.pp_list ~sep:":@ " self#name) names
- self#pred_prec (Precedence.upperLevel, content)
+ fprintf fmt "(@[<hv 2>%a:@ %a@])"
+ (Pretty_utils.pp_list ~sep:":@ " self#name) names
+ self#pred_prec (Precedence.upperLevel, content)
method private pred_prec_named fmt (parenth,p) =
self#named_pred fmt (parenth,p.pred_name,p.pred_content)
@@ -2474,7 +2474,7 @@ class cil_printer () = object (self)
method private preds kw fmt l =
Pretty_utils.pp_list ~suf:"@]@\n" ~sep:"@\n"
(fun fmt p ->
- fprintf fmt "@[%s %a;@]" kw self#identified_predicate p) fmt l
+ fprintf fmt "@[%s %a;@]" kw self#identified_predicate p) fmt l
method private pand_list fmt l =
let term = self#term_prec Precedence.comparativeLevel in
@@ -2517,75 +2517,75 @@ class cil_printer () = object (self)
(if Kernel.Unicode.get () then Utf8_logic.inset else "\\in")
self#term tr
| None ->
- fprintf fmt "@[%a%a%a@]"
- self#logic_info pi
- self#labels labels
- (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ " self#term) l
- end
+ fprintf fmt "@[%a%a%a@]"
+ self#logic_info pi
+ self#labels labels
+ (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ " self#term) l
+ end
| Prel (rel,l,r) ->
fprintf fmt "@[%a@ %a@ %a@]" term l self#relation rel term r
| Pand (p1, p2) when not state.print_cil_as_is ->
fprintf fmt "@[%a@]" self#pand_list (get_pand_list p1 [p2])
| Pand (p1,p2) ->
fprintf fmt "@[%a %a@ %a@]"
- self#pred_prec_named (current_level,p1)
- self#term_binop LAnd
- self#pred_prec_named (current_level,p2)
+ self#pred_prec_named (current_level,p1)
+ self#term_binop LAnd
+ self#pred_prec_named (current_level,p2)
| Por (p1, p2) ->
fprintf fmt "@[%a %a@ %a@]"
- self#pred_prec_named (current_level,p1)
- self#term_binop LOr
- self#pred_prec_named (current_level,p2)
+ self#pred_prec_named (current_level,p1)
+ self#term_binop LOr
+ self#pred_prec_named (current_level,p2)
| Pxor (p1, p2) ->
fprintf fmt "@[%a %s@ %a@]"
- self#pred_prec_named (current_level,p1)
- (if Kernel.Unicode.get () then Utf8_logic.x_or else "^^")
- self#pred_prec_named (current_level,p2)
+ self#pred_prec_named (current_level,p1)
+ (if Kernel.Unicode.get () then Utf8_logic.x_or else "^^")
+ self#pred_prec_named (current_level,p2)
| Pimplies (p1,p2) ->
fprintf fmt "@[%a %s@ %a@]"
- self#pred_prec_named (current_level,p1)
- (if Kernel.Unicode.get () then Utf8_logic.implies else "==>")
- self#pred_prec_named (current_level+1,p2)
+ self#pred_prec_named (current_level,p1)
+ (if Kernel.Unicode.get () then Utf8_logic.implies else "==>")
+ self#pred_prec_named (current_level+1,p2)
| Piff (p1,p2) ->
fprintf fmt "@[%a %s@ %a@]"
- self#pred_prec_named (current_level,p1)
- (if Kernel.Unicode.get () then Utf8_logic.iff else "<==>")
- self#pred_prec_named (current_level,p2)
+ self#pred_prec_named (current_level,p1)
+ (if Kernel.Unicode.get () then Utf8_logic.iff else "<==>")
+ self#pred_prec_named (current_level,p2)
| Pnot a -> fprintf fmt "@[%s%a@]"
(if Kernel.Unicode.get () then Utf8_logic.neg else "!")
self#pred_prec_named (current_level,a)
| Pif (e, p1, p2) ->
fprintf fmt "@[<hv 2>%a?@ %a:@ %a@]"
- term e
- self#pred_prec_named (current_level, p1)
- self#pred_prec_named (current_level, p2)
+ term e
+ self#pred_prec_named (current_level, p1)
+ self#pred_prec_named (current_level, p2)
| Plet (def, p) ->
assert
- (Kernel.verify (def.l_labels = [])
- "invalid logic construction: local definition with label");
+ (Kernel.verify (def.l_labels = [])
+ "invalid logic construction: local definition with label");
assert
- (Kernel.verify (def.l_tparams = [])
- "invalid logic construction: polymorphic local definition");
+ (Kernel.verify (def.l_tparams = [])
+ "invalid logic construction: polymorphic local definition");
let v = def.l_var_info in
let args = def.l_profile in
let pp_defn = match def.l_body with
- | LBterm t -> fun fmt -> self#term fmt t
- | LBpred p -> fun fmt -> self#pred_prec_named fmt (current_level,p)
- | LBnone
- | LBreads _ | LBinductive _ ->
- Kernel.fatal "invalid logic local definition"
+ | LBterm t -> fun fmt -> self#term fmt t
+ | LBpred p -> fun fmt -> self#pred_prec_named fmt (current_level,p)
+ | LBnone
+ | LBreads _ | LBinductive _ ->
+ Kernel.fatal "invalid logic local definition"
in
Precedence.needIndent current_level p fmt
"@[<hov 2>%a@ %a =@ %t%t;@]@ %a"
self#pp_acsl_keyword "\\let"
- self#logic_var v
- (fun fmt ->
- if args <> [] then
- fprintf fmt "@[<hv 2>%a@ %a;@]@ "
+ self#logic_var v
+ (fun fmt ->
+ if args <> [] then
+ fprintf fmt "@[<hv 2>%a@ %a;@]@ "
self#pp_acsl_keyword "\\lambda"
self#quantifiers args)
- pp_defn
- self#pred_prec_named (current_level,p)
+ pp_defn
+ self#pred_prec_named (current_level,p)
| Pforall (quant,pred) ->
Precedence.needIndent current_level pred fmt
"@[%t %a;@]@ %a"
@@ -2631,22 +2631,22 @@ class cil_printer () = object (self)
| Pfresh (l1,l2,e1,e2) ->
fprintf fmt "@[%a%a(@[%a@],@[%a@])@]"
self#pp_acsl_keyword "\\fresh"
- self#labels [l1;l2] self#term e1 self#term e2
+ self#labels [l1;l2] self#term e1 self#term e2
| Pseparated seps ->
fprintf fmt "@[<hv 2>%a(@,%a@,)@]"
self#pp_acsl_keyword "\\separated"
- (Pretty_utils.pp_list ~sep:",@ " self#term) seps
+ (Pretty_utils.pp_list ~sep:",@ " self#term) seps
| Pat(p,lab) ->
let old_label = current_label in
current_label <- lab;
if Cil_datatype.Logic_label.equal lab Logic_const.old_label then
- fprintf fmt "@[%a(@[%a@])@]"
+ fprintf fmt "@[%a(@[%a@])@]"
self#pp_acsl_keyword "\\old"
- self#pred_prec_named (Precedence.upperLevel,p)
+ self#pred_prec_named (Precedence.upperLevel,p)
else
- fprintf fmt "@[%a(@[@[%a@],@,%a@])@]"
+ fprintf fmt "@[%a(@[@[%a@],@,%a@])@]"
self#pp_acsl_keyword "\\at"
- self#pred_prec_named (Precedence.upperLevel,p)
+ self#pred_prec_named (Precedence.upperLevel,p)
self#logic_label lab;
current_label <- old_label
| Psubtype (e,ce) ->
@@ -2675,8 +2675,8 @@ class cil_printer () = object (self)
self#pp_acsl_keyword "requires"
self#identified_predicate p
- method extended fmt (id, name, l,ext) =
- Behavior_extensions.pp (self :> extensible_printer_type) fmt (id,name,l,ext)
+ method extended fmt (ext : acsl_extension) =
+ Behavior_extensions.pp (self :> extensible_printer_type) fmt ext
method post_cond fmt (k,p) =
let kw = get_termination_kind_name k in
@@ -2700,19 +2700,19 @@ class cil_printer () = object (self)
method allocation ~isloop fmt = function
| FreeAllocAny -> ()
- | FreeAlloc([],[]) ->
+ | FreeAlloc([],[]) ->
fprintf fmt "@[%a@ %a;@]"
self#pp_acsl_keyword (if isloop then "loop allocates" else "allocates")
self#pp_acsl_keyword "\\nothing"
| FreeAlloc(f,a) ->
let pFreeAlloc kw fmt = function
| [] -> ()
- | _ :: _ as af ->
- fprintf fmt "@[%a@ %a;@]"
- self#pp_acsl_keyword (if isloop then "loop "^kw else kw)
- (Pretty_utils.pp_list ~sep:",@ " self#identified_term) af
+ | _ :: _ as af ->
+ fprintf fmt "@[%a@ %a;@]"
+ self#pp_acsl_keyword (if isloop then "loop "^kw else kw)
+ (Pretty_utils.pp_list ~sep:",@ " self#identified_term) af
in
- fprintf fmt "@[<v>%a%(%)%a@]"
+ fprintf fmt "@[<v>%a%(%)%a@]"
(pFreeAlloc "frees") f
(if f != [] && a != [] then format_of_string "@ " else "")
(pFreeAlloc "allocates") a
@@ -2724,14 +2724,14 @@ class cil_printer () = object (self)
| Writes l ->
let without_result =
List.filter
- (function (a,_) -> not (Logic_const.is_exit_status a.it_content))
+ (function (a,_) -> not (Logic_const.is_exit_status a.it_content))
l
in
fprintf fmt "@[<h>%t%a@]"
(fun fmt -> if without_result <> [] then
Format.fprintf fmt "%a " self#pp_acsl_keyword kw)
(Pretty_utils.pp_list ~sep:",@ " ~suf:";@]"
- (fun fmt (t, _) -> self#identified_term fmt t))
+ (fun fmt (t, _) -> self#identified_term fmt t))
without_result
method private assigns_deps kw fmt = function
@@ -2746,7 +2746,7 @@ class cil_printer () = object (self)
method from kw fmt (base,deps) = match deps with
| FromAny -> ()
| From [] ->
- fprintf fmt "@[<hv 2>@[<h>%a@ %a@]@ @[<h>%a %a@];@]"
+ fprintf fmt "@[<hv 2>@[<h>%a@ %a@]@ @[<h>%a %a@];@]"
self#pp_acsl_keyword kw
self#identified_term base
self#pp_acsl_keyword "\\from"
@@ -2761,17 +2761,17 @@ class cil_printer () = object (self)
(* not enclosed in a box *)
method private terminates_decreases ~extra_nl nl fmt (terminates, variant) =
let nl_terminates = nl || variant != None in
- let pp_opt nl fmt =
+ let pp_opt nl fmt =
let suf = if nl then format_of_string "@]@\n" else "@]" in
- Pretty_utils.pp_opt ~suf fmt
+ Pretty_utils.pp_opt ~suf fmt
in
fprintf fmt "%a%a%(%)"
(pp_opt nl_terminates self#terminates) terminates
(pp_opt nl self#decreases) variant
- (format_of_string
- (if extra_nl && nl && (variant != None || terminates != None)
- then format_of_string "@\n"
- else ""))
+ (format_of_string
+ (if extra_nl && nl && (variant != None || terminates != None)
+ then format_of_string "@\n"
+ else ""))
(* not enclosed in a box *)
method private behavior_contents ~extra_nl nl ?terminates ?variant fmt b =
@@ -2813,22 +2813,22 @@ class cil_printer () = object (self)
self#pp_acsl_keyword "behavior"
b.b_name
(self#behavior_contents ~extra_nl:false false
- ?terminates:None ?variant:None)
+ ?terminates:None ?variant:None)
b
method funspec fmt ({ spec_behavior = behaviors;
- spec_variant = variant;
- spec_terminates = terminates;
- spec_complete_behaviors = complete;
- spec_disjoint_behaviors = disjoint } as spec) =
- let pp_list ?(extra_nl=false) nl fmt =
- let suf =
+ spec_variant = variant;
+ spec_terminates = terminates;
+ spec_complete_behaviors = complete;
+ spec_disjoint_behaviors = disjoint } as spec) =
+ let pp_list ?(extra_nl=false) nl fmt =
+ let suf =
if nl then
if extra_nl then format_of_string "@]@\n@\n" else "@]@\n"
else "@]"
in
let sep = if extra_nl then format_of_string "@\n@\n" else "@\n" in
- Pretty_utils.pp_list ~pre:"@[<v>" ~sep ~suf fmt
+ Pretty_utils.pp_list ~pre:"@[<v>" ~sep ~suf fmt
in
fprintf fmt "@[<v>";
let default_bhv = Cil.find_default_behavior spec in
@@ -2839,31 +2839,31 @@ class cil_printer () = object (self)
let nl_other_bhvs = nl_complete || complete != [] in
let nl_default = nl_other_bhvs || other_bhvs != [] in
(match default_bhv with
- | None ->
+ | None ->
self#terminates_decreases ~extra_nl:nl_default nl_default fmt
- (terminates, variant)
+ (terminates, variant)
| Some b
when b.b_assumes == [] && b.b_requires == [] && b.b_post_cond == []
- && b.b_extended == []
- && b.b_allocation == FreeAllocAny && b.b_assigns == WritesAny ->
+ && b.b_extended == []
+ && b.b_allocation == FreeAllocAny && b.b_assigns == WritesAny ->
self#terminates_decreases ~extra_nl:nl_default nl_default fmt
- (terminates, variant)
- | Some b ->
- self#behavior_contents
- ~extra_nl:nl_default nl_default ?terminates ?variant fmt b);
+ (terminates, variant)
+ | Some b ->
+ self#behavior_contents
+ ~extra_nl:nl_default nl_default ?terminates ?variant fmt b);
fprintf fmt "%a%a%a@]"
(pp_list ~extra_nl:true nl_other_bhvs self#behavior) other_bhvs
(pp_list nl_complete self#complete_behaviors) complete
(pp_list false self#disjoint_behaviors) disjoint
method private loop_pragma fmt = function
- | Widen_hints terms ->
+ | Widen_hints terms ->
fprintf fmt "WIDEN_HINTS @[%a@]"
(Pretty_utils.pp_list ~sep:",@ " self#term) terms
- | Widen_variables terms ->
+ | Widen_variables terms ->
fprintf fmt "WIDEN_VARIABLES @[%a@]"
(Pretty_utils.pp_list ~sep:",@ " self#term) terms
- | Unroll_specs terms ->
+ | Unroll_specs terms ->
fprintf fmt "UNROLL @[%a@]"
(Pretty_utils.pp_list ~sep:",@ " self#term) terms
@@ -2877,7 +2877,7 @@ class cil_printer () = object (self)
| IPstmt -> Format.pp_print_string fmt "stmt"
(* TODO: add the annot ID in debug mode?*)
- method code_annotation fmt ca =
+ method code_annotation fmt ca =
let pp_for_behavs fmt l =
match l with
| [] -> ()
@@ -2932,7 +2932,7 @@ class cil_printer () = object (self)
let prefix = if is_loop then "loop " else "" in
fprintf fmt "@[<2>%a%s%a@]"
pp_for_behavs behav prefix
- (Behavior_extensions.pp (self:>Printer_api.extensible_printer_type)) e
+ self#extended e
method private logicPrms fmt arg =
let pvar fmt = self#logic_var fmt arg in
@@ -2960,9 +2960,9 @@ class cil_printer () = object (self)
| FormalLabel s -> pp_print_string fmt s
| StmtLabel sref ->
let rec pickLabel = function
- | [] -> None
- | Label (l, _, _) :: _ -> Some l
- | _ :: rest -> pickLabel rest
+ | [] -> None
+ | Label (l, _, _) :: _ -> Some l
+ | _ :: rest -> pickLabel rest
in
let s = match pickLabel !sref.labels with
| Some l -> l
@@ -2971,14 +2971,14 @@ class cil_printer () = object (self)
pp_print_string fmt s
method private labels fmt labels =
- match labels with
+ match labels with
| [ l ] when
- Cil_datatype.Logic_label.equal current_label l
+ Cil_datatype.Logic_label.equal current_label l
&& not state.print_cil_as_is
-> ()
| _ ->
Pretty_utils.pp_list ~pre:"{@[" ~suf:"@]}" ~sep:",@ "
- self#logic_label fmt labels
+ self#logic_label fmt labels
method model_info fmt mfi =
let print_decl fmt = self#model_field fmt mfi in
@@ -2994,8 +2994,8 @@ class cil_printer () = object (self)
fprintf fmt "@[<hv 2>@[%a %a%a=@]@ %a;@]@\n"
self#pp_acsl_keyword "type invariant"
self#logic_var a.l_var_info
- (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@] " ~sep:",@ "
- self#logicPrms) a.l_profile
+ (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@] " ~sep:",@ "
+ self#logicPrms) a.l_profile
self#predicate (pred_body a.l_body);
current_label <- old_label
| Dmodel_annot (mfi,_) ->
@@ -3041,7 +3041,7 @@ class cil_printer () = object (self)
| Some rt ->
fprintf fmt "@[<hov 2>@[%a %a"
self#pp_acsl_keyword "logic"
- (self#logic_type None) rt
+ (self#logic_type None) rt
| None ->
(match li.l_body with
| LBinductive _ ->
@@ -3054,7 +3054,7 @@ class cil_printer () = object (self)
self#labels li.l_labels
self#polyTypePrms li.l_tparams
(Pretty_utils.pp_list ~pre:"@[(" ~suf:")@] " ~sep:",@ "
- self#logicPrms)
+ self#logicPrms)
li.l_profile;
(* Except for inductive definitions, where this must be done for
each individual case that declare a unique label, if the predicate
@@ -3070,15 +3070,15 @@ class cil_printer () = object (self)
fprintf fmt "@]@\n@[%a %a;@]"
self#pp_acsl_keyword "reads" self#pp_acsl_keyword "\\nothing"
| _ ->
- fprintf fmt "@]@\n@[%a@ %a;@]"
+ fprintf fmt "@]@\n@[%a@ %a;@]"
self#pp_acsl_keyword "reads"
- (Pretty_utils.pp_list
- ~sep:",@ "
- (fun fmt x -> self#term fmt x.it_content)) reads)
+ (Pretty_utils.pp_list
+ ~sep:",@ "
+ (fun fmt x -> self#term fmt x.it_content)) reads)
| LBpred def ->
(match li.l_labels with | [ l ] -> current_label <- l | _ -> ());
fprintf fmt "=@]@ %a;"
- self#predicate def
+ self#predicate def
| LBinductive indcases ->
fprintf fmt "{@]@ %a}"
(Pretty_utils.pp_list ~pre:"@[<v 0>" ~suf:"@]@\n" ~sep:"@\n"
@@ -3097,7 +3097,7 @@ class cil_printer () = object (self)
| LBterm def ->
(match li.l_labels with | [ l ] -> current_label <- l | _ -> ());
fprintf fmt "=@]@ %a;"
- self#term def);
+ self#term def);
fprintf fmt "@]@\n";
current_label <- old_lab
| Dvolatile(tsets,rvi_opt,wvi_opt,_attr, _) ->
@@ -3109,7 +3109,7 @@ class cil_printer () = object (self)
fprintf fmt "@[<hov 2>%a@ %a%a%a;@]"
self#pp_acsl_keyword "volatile"
(Pretty_utils.pp_list ~sep:",@ "
- (fun fmt x -> self#term fmt x.it_content))
+ (fun fmt x -> self#term fmt x.it_content))
tsets
(pp_vol "reads") rvi_opt
(pp_vol "writes") wvi_opt ;
@@ -3119,7 +3119,7 @@ class cil_printer () = object (self)
self#pp_acsl_keyword "axiomatic"
id
(Pretty_utils.pp_list ~pre:"@[<v 0>" ~suf:"@]@\n" ~sep:"@\n"
- self#global_annotation)
+ self#global_annotation)
decls
| Dextended (e,_attr,_) -> self#extended fmt e
@@ -3127,10 +3127,10 @@ class cil_printer () = object (self)
| LTsum l ->
Pretty_utils.pp_list ~sep:"@ |@ "
(fun fmt info ->
- fprintf fmt "%s@[%a@]" info.ctor_name
- (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ "
- (self#logic_type None)) info.ctor_params) fmt l
- | LTsyn typ ->
+ fprintf fmt "%s@[%a@]" info.ctor_name
+ (Pretty_utils.pp_list ~pre:"@[(" ~suf:")@]" ~sep:",@ "
+ (self#logic_type None)) info.ctor_params) fmt l
+ | LTsyn typ ->
self#logic_type None fmt typ
method file fmt file =
diff --git a/src/kernel_services/ast_printing/cil_printer.mli b/src/kernel_services/ast_printing/cil_printer.mli
index 1eb890808ea36782f8e71e5e506f5211a25df895..3edbd8bc09e81650ba7cc7a2caff541df00960ce 100644
--- a/src/kernel_services/ast_printing/cil_printer.mli
+++ b/src/kernel_services/ast_printing/cil_printer.mli
@@ -41,7 +41,7 @@ val register_behavior_extension:
Cil_types.acsl_extension_kind -> unit) -> unit
(** Register a pretty-printer used for behavior extension.
@plugin development guide
- *)
+*)
val register_global_extension:
string ->
@@ -49,7 +49,7 @@ val register_global_extension:
Cil_types.acsl_extension_kind -> unit) -> unit
(** Register a pretty-printer used for behavior extension.
@plugin development guide
- *)
+*)
val register_code_annot_extension:
string ->
@@ -57,7 +57,7 @@ val register_code_annot_extension:
Cil_types.acsl_extension_kind -> unit) -> unit
(** Register a pretty-printer used for behavior extension.
@plugin development guide
- *)
+*)
val register_loop_annot_extension:
string ->
@@ -65,7 +65,7 @@ val register_loop_annot_extension:
Cil_types.acsl_extension_kind -> unit) -> unit
(** Register a pretty-printer used for behavior extension.
@plugin development guide
- *)
+*)
val state: Printer_api.state
diff --git a/src/kernel_services/ast_printing/cil_types_debug.ml b/src/kernel_services/ast_printing/cil_types_debug.ml
index 8a0c8c33b31b0bc6d935ae21281db06035f22010..029bb8bf79afab4827fed87758d55056bba87b69 100644
--- a/src/kernel_services/ast_printing/cil_types_debug.ml
+++ b/src/kernel_services/ast_printing/cil_types_debug.ml
@@ -34,7 +34,7 @@ let print_locations = false
(* compinfo, fieldinfo, enuminfo, typeinfo and varinfo are shortened by default.
Setting several to true may result in infinite mutually recursive calls!
- *)
+*)
let print_full_compinfo = false
let print_full_fieldinfo = false
let print_full_enuminfo = false
@@ -413,9 +413,9 @@ and pp_exp_node fmt = function
| Info(exp,exp_info) -> Format.fprintf fmt "Info(%a,%a)" pp_exp exp pp_exp_info exp_info
and pp_exp_info fmt _exp_info = Format.fprintf fmt "pp_exp_info_TODO" (*{
- exp_type : logic_type;
- exp_name: string_list;
-}*)
+ exp_type : logic_type;
+ exp_name: string_list;
+ }*)
and pp_constant fmt = function
| CInt64(integer,ikind,string_option) ->
@@ -476,21 +476,21 @@ and pp_init fmt = function
and pp_initinfo fmt _initinfo = Format.fprintf fmt "pp_initinfo_TODO" (*{ mutable init : init_option }*)
and pp_fundec fmt _fundec = Format.fprintf fmt "pp_fundec_TODO" (*{
- mutable svar: varinfo;
- mutable sformals: varinfo_list;
- mutable slocals: varinfo_list;
- mutable smaxid: int;
- mutable sbody: block;
- mutable smaxstmtid: int_option;
- mutable sallstmts: stmt_list;
- mutable sspec: funspec;
-}*)
+ mutable svar: varinfo;
+ mutable sformals: varinfo_list;
+ mutable slocals: varinfo_list;
+ mutable smaxid: int;
+ mutable sbody: block;
+ mutable smaxstmtid: int_option;
+ mutable sallstmts: stmt_list;
+ mutable sspec: funspec;
+ }*)
and pp_block fmt _block = Format.fprintf fmt "pp_block_TODO" (*{
- mutable battrs: attributes;
- mutable blocals: varinfo_list;
- mutable bstmts: stmt_list;
-}*)
+ mutable battrs: attributes;
+ mutable blocals: varinfo_list;
+ mutable bstmts: stmt_list;
+ }*)
and pp_stmt fmt stmt = Format.fprintf fmt
"{sid=%a;labels=%a;skind=%a;ghost=%a;TODO}"
@@ -570,12 +570,12 @@ and pp_instr fmt = function
Format.fprintf fmt "Local_init(%a,%a,%a)" pp_varinfo vi pp_local_init i pp_location location
and pp_extended_asm fmt _extended_asm = Format.fprintf fmt "pp_extended_asm_TODO" (*{
- {
- asm_outputs: (string_option * string * lval)_list;
- asm_inputs: (string_option * string * exp)_list;
- asm_clobbers: string_list;
- asm_gotos: (stmt ref)_list;
-}*)
+ {
+ asm_outputs: (string_option * string * lval)_list;
+ asm_inputs: (string_option * string * exp)_list;
+ asm_clobbers: string_list;
+ asm_gotos: (stmt ref)_list;
+ }*)
and pp_filepath_position fmt filepath_position =
Format.fprintf fmt "{pos_path=%s;pos_lnum=%d;pos_bol=%d;pos_cnum=%d}"
@@ -606,11 +606,11 @@ and pp_logic_constant fmt = function
| LEnum(enumitem) -> Format.fprintf fmt "LEnum(%a)" pp_enumitem enumitem
and pp_logic_real fmt _logic_real = Format.fprintf fmt "pp_logic_real_TODO" (*{
- r_literal : string ;
- r_nearest : float ;
- r_upper : float ;
- r_lower : float ;
-}*)
+ r_literal : string ;
+ r_nearest : float ;
+ r_upper : float ;
+ r_lower : float ;
+ }*)
and pp_logic_type fmt = function
| Ctype(typ) -> Format.fprintf fmt "Ctype(%a)" pp_typ typ
@@ -710,13 +710,13 @@ and pp_term_lhost fmt = function
| TMem(term) -> Format.fprintf fmt "TMem(%a)" pp_term term
and pp_model_info fmt _model_info = Format.fprintf fmt "pp_model_info_TODO" (*{
- mi_name: string;
- mi_field_type: logic_type;
- mi_base_type: typ;
- mi_decl: location;
- mutable mi_attr: attributes;
+ mi_name: string;
+ mi_field_type: logic_type;
+ mi_base_type: typ;
+ mi_decl: location;
+ mutable mi_attr: attributes;
-}*)
+ }*)
and pp_term_offset fmt = function
| TNoOffset -> Format.fprintf fmt "TNoOffset"
@@ -740,15 +740,15 @@ and pp_logic_info fmt logic_info =
mutable l_type : logic_type_option;
mutable l_profile : logic_var_list;
mutable l_body : logic_body;
-}*)
+ }*)
and pp_builtin_logic_info fmt _builtin_logic_info = Format.fprintf fmt "pp_builtin_logic_info_TODO" (*{
- mutable bl_name: string;
- mutable bl_labels: logic_label_list;
- mutable bl_params: string_list;
- mutable bl_type: logic_type_option;
- mutable bl_profile: (string * logic_type)_list;
-}*)
+ mutable bl_name: string;
+ mutable bl_labels: logic_label_list;
+ mutable bl_params: string_list;
+ mutable bl_type: logic_type_option;
+ mutable bl_profile: (string * logic_type)_list;
+ }*)
and pp_logic_body fmt = function
| LBnone -> Format.fprintf fmt "LBnone"
@@ -789,7 +789,7 @@ and pp_logic_var fmt logic_var =
mutable lv_kind: logic_var_kind;
mutable lv_origin : varinfo_option;
mutable lv_attr: attributes
-}*)
+ }*)
and pp_logic_ctor_info fmt logic_ctor_info =
Format.fprintf fmt "{ctor_name=%a;ctor_type=TODO;ctor_params=%a}"
@@ -860,7 +860,7 @@ and pp_predicate_node fmt = function
Format.fprintf fmt "Pfresh(%a,%a,%a,%a)" pp_logic_label logic_label1 pp_logic_label logic_label2
pp_term term1 pp_term term2
| Psubtype(term1,term2) ->
- Format.fprintf fmt "Psubtype(%a,%a)" pp_term term1 pp_term term2
+ Format.fprintf fmt "Psubtype(%a,%a)" pp_term term1 pp_term term2
and pp_identified_predicate fmt identified_predicate =
Format.fprintf fmt "{ip_id=%d;ip_content=%a}"
@@ -872,14 +872,14 @@ and pp_predicate fmt predicate = Format.fprintf fmt "{%a%apred_content=%a}"
pp_predicate_node predicate.pred_content
and pp_spec fmt _spec = Format.fprintf fmt "pp_spec_TODO" (*{
- mutable spec_behavior : behavior_list;
- mutable spec_variant : term variant_option;
- mutable spec_terminates: identified_predicate_option;
- mutable spec_complete_behaviors: string_list_list;
- mutable spec_disjoint_behaviors: string_list_list;
-}*)
+ mutable spec_behavior : behavior_list;
+ mutable spec_variant : term variant_option;
+ mutable spec_terminates: identified_predicate_option;
+ mutable spec_complete_behaviors: string_list_list;
+ mutable spec_disjoint_behaviors: string_list_list;
+ }*)
-and pp_acsl_extension fmt = pp_tuple4 pp_int pp_string pp_location pp_acsl_extension_kind fmt
+and pp_acsl_extension fmt = pp_tuple5 pp_int pp_string pp_location pp_bool pp_acsl_extension_kind fmt
and pp_acsl_extension_kind fmt = function
| Ext_id(int) -> Format.fprintf fmt "Ext_id(%a)" pp_int int
@@ -887,14 +887,14 @@ and pp_acsl_extension_kind fmt = function
| Ext_preds(predicate_list) -> Format.fprintf fmt "Ext_preds(%a)" (pp_list pp_predicate) predicate_list
and pp_behavior fmt _behavior = Format.fprintf fmt "pp_behavior_TODO" (*{
- mutable b_name : string;
- mutable b_requires : identified_predicate_list;
- mutable b_assumes : identified_predicate_list;
- mutable b_post_cond : (termination_kind * identified_predicate)_list;
- mutable b_assigns : assigns;
- mutable b_allocation : allocation;
- mutable b_extended : acsl_extension_list
-}*)
+ mutable b_name : string;
+ mutable b_requires : identified_predicate_list;
+ mutable b_assumes : identified_predicate_list;
+ mutable b_post_cond : (termination_kind * identified_predicate)_list;
+ mutable b_assigns : assigns;
+ mutable b_allocation : allocation;
+ mutable b_extended : acsl_extension_list
+ }*)
and pp_termination_kind fmt = function
| Normal -> Format.fprintf fmt "Normal"
@@ -946,9 +946,9 @@ and pp_code_annotation_node fmt = function
and pp_funspec fmt _funspec = Format.fprintf fmt "pp_funspec_TODO"
and pp_code_annotation fmt _code_annotation = Format.fprintf fmt "pp_code_annotation_TODO" (*{
- annot_id: int;
- annot_content : code_annotation_node;
-}*)
+ annot_id: int;
+ annot_content : code_annotation_node;
+ }*)
and pp_funbehavior fmt = pp_behavior fmt
@@ -998,9 +998,9 @@ let pp_cil_function fmt = function
(pp_option (pp_list pp_varinfo)) varinfo_list_option pp_location location
let pp_kernel_function fmt _kernel_function = Format.fprintf fmt "pp_kernel_function_TODO" (*{
- mutable fundec : cil_function;
- mutable spec : funspec;
-}*)
+ mutable fundec : cil_function;
+ mutable spec : funspec;
+ }*)
let pp_localisation fmt = function
| VGlobal -> Format.fprintf fmt "VGlobal"
@@ -1008,37 +1008,37 @@ let pp_localisation fmt = function
| VFormal(kernel_function) -> Format.fprintf fmt "VFormal(%a)" pp_kernel_function kernel_function
let pp_mach fmt _mach = Format.fprintf fmt "pp_mach_TODO" (*{
- sizeof_short: int;
- sizeof_int: int;
- sizeof_long: int ;
- sizeof_longlong: int;
- sizeof_ptr: int;
- sizeof_float: int;
- sizeof_double: int;
- sizeof_longdouble: int;
- sizeof_void: int;
- sizeof_fun: int;
- size_t: string;
- wchar_t: string;
- ptrdiff_t: string;
- alignof_short: int;
- alignof_int: int;
- alignof_long: int;
- alignof_longlong: int;
- alignof_ptr: int;
- alignof_float: int;
- alignof_double: int;
- alignof_longdouble: int;
- alignof_str: int;
- alignof_fun: int;
- char_is_unsigned: bool;
- underscore_name: bool;
- const_string_literals: bool;
- little_endian: bool;
- alignof_aligned: int;
- has__builtin_va_list: bool;
- __thread_is_keyword: bool;
- compiler: string;
- cpp_arch_flags: string_list;
- version: string;
-}*)
+ sizeof_short: int;
+ sizeof_int: int;
+ sizeof_long: int ;
+ sizeof_longlong: int;
+ sizeof_ptr: int;
+ sizeof_float: int;
+ sizeof_double: int;
+ sizeof_longdouble: int;
+ sizeof_void: int;
+ sizeof_fun: int;
+ size_t: string;
+ wchar_t: string;
+ ptrdiff_t: string;
+ alignof_short: int;
+ alignof_int: int;
+ alignof_long: int;
+ alignof_longlong: int;
+ alignof_ptr: int;
+ alignof_float: int;
+ alignof_double: int;
+ alignof_longdouble: int;
+ alignof_str: int;
+ alignof_fun: int;
+ char_is_unsigned: bool;
+ underscore_name: bool;
+ const_string_literals: bool;
+ little_endian: bool;
+ alignof_aligned: int;
+ has__builtin_va_list: bool;
+ __thread_is_keyword: bool;
+ compiler: string;
+ cpp_arch_flags: string_list;
+ version: string;
+ }*)
diff --git a/src/kernel_services/ast_printing/cil_types_debug.mli b/src/kernel_services/ast_printing/cil_types_debug.mli
index e8b52c76c1c5ebdde2b17623a18563afc710a189..e6cca0530b106f31f0b6b162c1d8e44a4a6fa6d7 100644
--- a/src/kernel_services/ast_printing/cil_types_debug.mli
+++ b/src/kernel_services/ast_printing/cil_types_debug.mli
@@ -169,4 +169,3 @@ val pp_cil_function : Format.formatter -> Cil_types.cil_function -> unit
val pp_kernel_function : Format.formatter -> 'a -> unit
val pp_localisation : Format.formatter -> Cil_types.localisation -> unit
val pp_mach : Format.formatter -> 'a -> unit
-
diff --git a/src/kernel_services/ast_printing/cprint.ml b/src/kernel_services/ast_printing/cprint.ml
index d3240945dbcd97800aff31a17efd5aa57be018b4..f8169bee15b726553ec0274ce89dfc58465824fd 100644
--- a/src/kernel_services/ast_printing/cprint.ml
+++ b/src/kernel_services/ast_printing/cprint.ml
@@ -42,25 +42,25 @@
(****************************************************************************)
(* cprint -- pretty printer of C program from abstract syntax
-**
-** Project: FrontC
-** File: cprint.ml
-** Version: 2.1e
-** Date: 9.1.99
-** Author: Hugues Cassé
-**
-** 1.0 2.22.99 Hugues Cassé First version.
-** 2.0 3.18.99 Hugues Cassé Compatible with Frontc 2.1, use of CAML
-** pretty printer.
-** 2.1 3.22.99 Hugues Cassé More efficient custom pretty printer used.
-** 2.1a 4.12.99 Hugues Cassé Correctly handle:
-** char *m, *m, *p; m + (n - p)
-** 2.1b 4.15.99 Hugues Cassé x + (y + z) stays x + (y + z) for
-** keeping computation order.
-** 2.1c 7.23.99 Hugues Cassé Improvement of case and default display.
-** 2.1d 8.25.99 Hugues Cassé Rebuild escape sequences in string and
-** characters.
-** 2.1e 9.1.99 Hugues Cassé Fix, recognize and correctly display '\0'.
+ **
+ ** Project: FrontC
+ ** File: cprint.ml
+ ** Version: 2.1e
+ ** Date: 9.1.99
+ ** Author: Hugues Cassé
+ **
+ ** 1.0 2.22.99 Hugues Cassé First version.
+ ** 2.0 3.18.99 Hugues Cassé Compatible with Frontc 2.1, use of CAML
+ ** pretty printer.
+ ** 2.1 3.22.99 Hugues Cassé More efficient custom pretty printer used.
+ ** 2.1a 4.12.99 Hugues Cassé Correctly handle:
+ ** char *m, *m, *p; m + (n - p)
+ ** 2.1b 4.15.99 Hugues Cassé x + (y + z) stays x + (y + z) for
+ ** keeping computation order.
+ ** 2.1c 7.23.99 Hugues Cassé Improvement of case and default display.
+ ** 2.1d 8.25.99 Hugues Cassé Rebuild escape sequences in string and
+ ** characters.
+ ** 2.1e 9.1.99 Hugues Cassé Fix, recognize and correctly display '\0'.
*)
(* George Necula: I changed this pretty dramatically since CABS changed *)
@@ -82,24 +82,24 @@ let printComments = ref false
(*
** Expression printing
-** Priorities
-** 16 variables
-** 15 . -> [] call()
-** 14 ++, -- (post)
-** 13 ++ -- (pre) ~ ! - + & *(cast)
-** 12 * / %
-** 11 + -
-** 10 << >>
-** 9 < <= > >=
-** 8 == !=
-** 7 &
-** 6 ^
-** 5 |
-** 4 &&
-** 3 ||
-** 2 ? :
-** 1 = ?=
-** 0 ,
+** Priorities
+** 16 variables
+** 15 . -> [] call()
+** 14 ++, -- (post)
+** 13 ++ -- (pre) ~ ! - + & *(cast)
+** 12 * / %
+** 11 + -
+** 10 << >>
+** 9 < <= > >=
+** 8 == !=
+** 7 &
+** 6 ^
+** 5 |
+** 4 &&
+** 3 ||
+** 2 ? :
+** 1 = ?=
+** 0 ,
*)
let cast_level = 13
@@ -109,49 +109,49 @@ let get_operator exp =
NOTHING -> ("", 16)
| PAREN _ -> ("", 16)
| UNARY (op, _) ->
- (match op with
- MINUS -> ("-", 13)
- | PLUS -> ("+", 13)
- | NOT -> ("!", 13)
- | BNOT -> ("~", 13)
- | MEMOF -> ("*", 13)
- | ADDROF -> ("&", 13)
- | PREINCR -> ("++", 13)
- | PREDECR -> ("--", 13)
- | POSINCR -> ("++", 14)
- | POSDECR -> ("--", 14))
+ (match op with
+ MINUS -> ("-", 13)
+ | PLUS -> ("+", 13)
+ | NOT -> ("!", 13)
+ | BNOT -> ("~", 13)
+ | MEMOF -> ("*", 13)
+ | ADDROF -> ("&", 13)
+ | PREINCR -> ("++", 13)
+ | PREDECR -> ("--", 13)
+ | POSINCR -> ("++", 14)
+ | POSDECR -> ("--", 14))
| LABELADDR _ -> ("", 16) (* Like a constant *)
| BINARY (op, _, _) ->
- (match op with
- MUL -> ("*", 12)
- | DIV -> ("/", 12)
- | MOD -> ("%", 12)
- | ADD -> ("+", 11)
- | SUB -> ("-", 11)
- | SHL -> ("<<", 10)
- | SHR -> (">>", 10)
- | LT -> ("<", 9)
- | LE -> ("<=", 9)
- | GT -> (">", 9)
- | GE -> (">=", 9)
- | EQ -> ("==", 8)
- | NE -> ("!=", 8)
- | BAND -> ("&", 7)
- | XOR -> ("^", 6)
- | BOR -> ("|", 5)
- | AND -> ("&&", 4)
- | OR -> ("||", 3)
- | ASSIGN -> ("=", 1)
- | ADD_ASSIGN -> ("+=", 1)
- | SUB_ASSIGN -> ("-=", 1)
- | MUL_ASSIGN -> ("*=", 1)
- | DIV_ASSIGN -> ("/=", 1)
- | MOD_ASSIGN -> ("%=", 1)
- | BAND_ASSIGN -> ("&=", 1)
- | BOR_ASSIGN -> ("|=", 1)
- | XOR_ASSIGN -> ("^=", 1)
- | SHL_ASSIGN -> ("<<=", 1)
- | SHR_ASSIGN -> (">>=", 1))
+ (match op with
+ MUL -> ("*", 12)
+ | DIV -> ("/", 12)
+ | MOD -> ("%", 12)
+ | ADD -> ("+", 11)
+ | SUB -> ("-", 11)
+ | SHL -> ("<<", 10)
+ | SHR -> (">>", 10)
+ | LT -> ("<", 9)
+ | LE -> ("<=", 9)
+ | GT -> (">", 9)
+ | GE -> (">=", 9)
+ | EQ -> ("==", 8)
+ | NE -> ("!=", 8)
+ | BAND -> ("&", 7)
+ | XOR -> ("^", 6)
+ | BOR -> ("|", 5)
+ | AND -> ("&&", 4)
+ | OR -> ("||", 3)
+ | ASSIGN -> ("=", 1)
+ | ADD_ASSIGN -> ("+=", 1)
+ | SUB_ASSIGN -> ("-=", 1)
+ | MUL_ASSIGN -> ("*=", 1)
+ | DIV_ASSIGN -> ("/=", 1)
+ | MOD_ASSIGN -> ("%=", 1)
+ | BAND_ASSIGN -> ("&=", 1)
+ | BOR_ASSIGN -> ("|=", 1)
+ | XOR_ASSIGN -> ("^=", 1)
+ | SHL_ASSIGN -> ("<<=", 1)
+ | SHR_ASSIGN -> (">>=", 1))
| QUESTION _ -> ("", 2)
| CAST _ -> ("", cast_level)
| CALL _ -> ("", 15)
@@ -214,46 +214,46 @@ and print_type_spec fmt = function
| Tnamed s -> fprintf fmt "%s" s
| Tstruct (n, None, _) -> fprintf fmt "struct %s" n
| Tstruct (n, Some flds, extraAttrs) ->
- fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
- (print_struct_name_attr "struct") (n, extraAttrs) print_fields flds
+ fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
+ (print_struct_name_attr "struct") (n, extraAttrs) print_fields flds
| Tunion (n, None, _) -> fprintf fmt "union %s" n
| Tunion (n, Some flds, extraAttrs) ->
- fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
- (print_struct_name_attr "union") (n, extraAttrs) print_fields flds
+ fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
+ (print_struct_name_attr "union") (n, extraAttrs) print_fields flds
| Tenum (n, None, _) -> fprintf fmt "enum %s" n
| Tenum (n, Some enum_items, extraAttrs) ->
- fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
- (print_struct_name_attr "enum") (n, extraAttrs)
- print_enum_items enum_items
+ fprintf fmt "@[<hov 2>%a@ {@ %a@;}@]"
+ (print_struct_name_attr "enum") (n, extraAttrs)
+ print_enum_items enum_items
| TtypeofE e -> fprintf fmt "__typeof__(@[%a@])" print_expression e
| TtypeofT (s,d) ->
- fprintf fmt "__typeof__(@[%a@])"print_onlytype (s, d)
+ fprintf fmt "__typeof__(@[%a@])"print_onlytype (s, d)
(* print "struct foo", but with specified keyword and a list of
* attributes to put between keyword and name *)
and print_struct_name_attr keyword fmt (name, extraAttrs) =
- fprintf fmt "%s%a%a@ %s"
- keyword
- (pp_cond (extraAttrs <> [])) "@ "
- print_attributes extraAttrs name
+ fprintf fmt "%s%a%a@ %s"
+ keyword
+ (pp_cond (extraAttrs <> [])) "@ "
+ print_attributes extraAttrs name
(* This is the main printer for declarations. It is easy because the
* declarations are laid out as they need to be printed. *)
and print_decl (n: string) fmt = function
JUSTBASE ->
- let cond = n = "___missing_field_name" in
- fprintf fmt "%a%s%a" (pp_cond cond) "/*@ " n (pp_cond cond) "@ */"
+ let cond = n = "___missing_field_name" in
+ fprintf fmt "%a%s%a" (pp_cond cond) "/*@ " n (pp_cond cond) "@ */"
| PARENTYPE (al1, d, al2) ->
- fprintf fmt "(@[%a%a%a@])"
- print_attributes al1 (print_decl n) d print_attributes al2
+ fprintf fmt "(@[%a%a%a@])"
+ print_attributes al1 (print_decl n) d print_attributes al2
| PTR (al, d) ->
- fprintf fmt "*%a%a" print_attributes al (print_decl n) d
+ fprintf fmt "*%a%a" print_attributes al (print_decl n) d
| ARRAY (d, al, e) ->
- fprintf fmt "%a[@[%a%a@]]"
- (print_decl n) d print_attributes al print_expression e
+ fprintf fmt "%a[@[%a%a@]]"
+ (print_decl n) d print_attributes al print_expression e
| PROTO(d, args, isva) ->
- fprintf fmt "@[%a@;(%a)@]"
- (print_decl n) d print_params (args,isva)
+ fprintf fmt "@[%a@;(%a)@]"
+ (print_decl n) d print_params (args,isva)
and print_fields fmt (flds : field_group list) =
pp_list ~sep:"@ " print_field_group fmt flds
@@ -273,8 +273,8 @@ and print_name fmt ((n, decl, attrs, _) : name) =
and print_init_name fmt ((n, i) : init_name) =
match i with
- NO_INIT -> print_name fmt n
- | _ -> fprintf fmt "%a@ =@ %a" print_name n print_init_expression i
+ NO_INIT -> print_name fmt n
+ | _ -> fprintf fmt "%a@ =@ %a" print_name n print_init_expression i
and print_name_group fmt (specs, names) =
fprintf fmt "%a@ %a"
@@ -282,17 +282,17 @@ and print_name_group fmt (specs, names) =
and print_field_group fmt fld = match fld with
| FIELD (specs, fields) ->
- fprintf fmt "%a@ %a;"
- print_specifiers specs
- (pp_list ~sep:",@ " print_field) fields
+ fprintf fmt "%a@ %a;"
+ print_specifiers specs
+ (pp_list ~sep:",@ " print_field) fields
| TYPE_ANNOT annot ->
- fprintf fmt "@\n/*@@@[@ %a@]@ */@\n"
- Logic_print.print_type_annot annot
+ fprintf fmt "@\n/*@@@[@ %a@]@ */@\n"
+ Logic_print.print_type_annot annot
and print_field fmt (name, widtho) =
match widtho with
- None -> print_name fmt name
- | Some w -> fprintf fmt "%a:@ %a" print_name name print_expression w
+ None -> print_name fmt name
+ | Some w -> fprintf fmt "%a:@ %a" print_name name print_expression w
and print_init_name_group fmt (specs, names) =
fprintf fmt "%a@ @[%a@]"
@@ -305,8 +305,8 @@ and print_params fmt (pars,ell) =
pp_list ~sep:",@ " print_single_name fmt pars;
if ell then begin
match pars with
- [] -> pp_print_string fmt "..."
- | _ -> fprintf fmt ",@ ..."
+ [] -> pp_print_string fmt "..."
+ | _ -> fprintf fmt ",@ ..."
end
and print_comma_exps fmt exps =
@@ -317,28 +317,28 @@ and print_init_expression fmt (iexp: init_expression) =
NO_INIT -> ()
| SINGLE_INIT e -> print_expression fmt e
| COMPOUND_INIT initexps ->
- let doinitexp fmt = function
- NEXT_INIT, e -> print_init_expression fmt e
- | i, e ->
- let rec doinit fmt = function
- NEXT_INIT -> ()
- | INFIELD_INIT (fn, i) -> fprintf fmt ".%s%a" fn doinit i
- | ATINDEX_INIT (e, i) ->
- fprintf fmt "[@[%a@]]%a" print_expression e doinit i
- | ATINDEXRANGE_INIT (s, e) ->
- fprintf fmt "@[%a@;...@;%a@]"
- print_expression s print_expression e
- in
- fprintf fmt "%a@ =@ %a"
- doinit i print_init_expression e
- in
- fprintf fmt "{@[<hov 2>%a@]}"
- (pp_list ~sep:",@ " doinitexp) initexps
+ let doinitexp fmt = function
+ NEXT_INIT, e -> print_init_expression fmt e
+ | i, e ->
+ let rec doinit fmt = function
+ NEXT_INIT -> ()
+ | INFIELD_INIT (fn, i) -> fprintf fmt ".%s%a" fn doinit i
+ | ATINDEX_INIT (e, i) ->
+ fprintf fmt "[@[%a@]]%a" print_expression e doinit i
+ | ATINDEXRANGE_INIT (s, e) ->
+ fprintf fmt "@[%a@;...@;%a@]"
+ print_expression s print_expression e
+ in
+ fprintf fmt "%a@ =@ %a"
+ doinit i print_init_expression e
+ in
+ fprintf fmt "{@[<hov 2>%a@]}"
+ (pp_list ~sep:",@ " doinitexp) initexps
and print_cast_expression fmt = function
NO_INIT -> Kernel.fatal "no init in cast"
| COMPOUND_INIT _ as ie ->
- fprintf fmt "(@[%a@])" print_init_expression ie
+ fprintf fmt "(@[%a@])" print_init_expression ie
| SINGLE_INIT e -> print_expression_level cast_level fmt e
and print_expression fmt (exp: expression) = print_expression_level 0 fmt exp
@@ -351,27 +351,27 @@ and print_expression_level (lvl: int) fmt (exp : expression) =
match e.expr_node with
NOTHING -> ()
| PAREN exp -> print_expression fmt exp
- (* parentheses are added by the level matching. *)
+ (* parentheses are added by the level matching. *)
| UNARY ((POSINCR|POSDECR), exp') ->
- fprintf fmt "%a%s" print_expression exp' txt
+ fprintf fmt "%a%s" print_expression exp' txt
| UNARY (_,exp') -> fprintf fmt "%s%a" txt print_expression exp'
| LABELADDR l -> fprintf fmt "&&%s" l
| BINARY (_op, exp1, exp2) ->
- fprintf fmt "%a@ %s@ %a"
- print_expression exp1 txt print_expression exp2
+ fprintf fmt "%a@ %s@ %a"
+ print_expression exp1 txt print_expression exp2
| QUESTION (exp1, exp2, exp3) ->
- fprintf fmt "%a@ ?@ %a@ :@ %a"
- print_expression exp1 print_expression exp2 print_expression exp3
+ fprintf fmt "%a@ ?@ %a@ :@ %a"
+ print_expression exp1 print_expression exp2 print_expression exp3
| CAST (typ, iexp) ->
- fprintf fmt "(@[%a@])@;%a"
- print_onlytype typ print_cast_expression iexp
+ fprintf fmt "(@[%a@])@;%a"
+ print_onlytype typ print_cast_expression iexp
| CALL ({ expr_node = VARIABLE "__builtin_va_arg"},
[arg; { expr_node = TYPE_SIZEOF (bt, dt) } ]) ->
- fprintf fmt "__builtin_va_arg(@[%a,@ %a@])"
- (print_expression_level 0) arg print_onlytype (bt, dt)
+ fprintf fmt "__builtin_va_arg(@[%a,@ %a@])"
+ (print_expression_level 0) arg print_onlytype (bt, dt)
| CALL (exp, args) ->
- fprintf fmt "%a(@[@;%a@])"
- print_expression exp print_comma_exps args
+ fprintf fmt "%a(@[@;%a@])"
+ print_expression exp print_comma_exps args
| CONSTANT (CONST_INT i) -> pp_print_string fmt i
| CONSTANT (CONST_FLOAT f) -> pp_print_string fmt f
| CONSTANT (CONST_CHAR c) -> fprintf fmt "'%s'" (escape_wstring c)
@@ -380,21 +380,21 @@ and print_expression_level (lvl: int) fmt (exp : expression) =
| CONSTANT (CONST_WSTRING s) -> print_wstring fmt s
| VARIABLE name -> pp_print_string fmt name
| EXPR_SIZEOF exp ->
- fprintf fmt "sizeof%a" print_expression exp
+ fprintf fmt "sizeof%a" print_expression exp
| TYPE_SIZEOF (bt,dt) ->
- fprintf fmt "sizeof(@[%a@])" print_onlytype (bt,dt)
+ fprintf fmt "sizeof(@[%a@])" print_onlytype (bt,dt)
| EXPR_ALIGNOF exp ->
- fprintf fmt "__alignof__%a" print_expression exp
+ fprintf fmt "__alignof__%a" print_expression exp
| TYPE_ALIGNOF (bt,dt) ->
- fprintf fmt "__alignof__(@[%a@])" print_onlytype (bt, dt)
+ fprintf fmt "__alignof__(@[%a@])" print_onlytype (bt, dt)
| INDEX (exp, idx) ->
- fprintf fmt "%a[@[%a@]]"
- print_expression exp (print_expression_level 0) idx
+ fprintf fmt "%a[@[%a@]]"
+ print_expression exp (print_expression_level 0) idx
| MEMBEROF (exp, fld) ->
- fprintf fmt "%a.%s" print_expression exp fld
+ fprintf fmt "%a.%s" print_expression exp fld
| MEMBEROFPTR (exp, fld) ->
- fprintf fmt "%a->%s"
- print_expression exp fld
+ fprintf fmt "%a->%s"
+ print_expression exp fld
| GNU_BODY blk -> fprintf fmt "(@[%a@])" print_block blk
| EXPR_PATTERN (name) -> fprintf fmt "@@expr(%s)" name
| COMMA l -> pp_list ~sep:",@ " print_expression fmt l
@@ -408,117 +408,117 @@ and print_expression_level (lvl: int) fmt (exp : expression) =
*)
and print_for_init fmt fc =
match fc with
- FC_EXP exp -> print_expression fmt exp
- | FC_DECL dec -> print_def fmt dec
+ FC_EXP exp -> print_expression fmt exp
+ | FC_DECL dec -> print_def fmt dec
and print_statement fmt stat =
let loc = Cabshelper.get_statementloc stat in
Cil_const.CurrentLoc.set loc;
- if Kernel.debug_atleast 2 then
+ if Kernel.debug_atleast 2 then
fprintf fmt "@\n/* %a */@\n" Cil_printer.pp_location loc;
match stat.stmt_node with
- NOP _ -> pp_print_string fmt ";"
- | COMPUTATION (exp,_) -> fprintf fmt "%a;" print_expression exp
- | BLOCK (blk, _,_) -> print_block fmt blk
- | SEQUENCE (s1, s2,_) ->
- fprintf fmt "%a;@ %a" print_statement s1 print_statement s2
- | IF (exp, s1, s2, _) ->
- fprintf fmt "@[<hov 2>if@ (@[%a@])@ %a@."
- print_expression exp print_substatement s1;
- (match s2.stmt_node with
- | NOP(_) -> fprintf fmt "@]"
- | _ -> fprintf fmt "@ else@ %a@]" print_substatement s2)
- | WHILE (annot,exp, stat,_) ->
- fprintf fmt "%a@[<hov 2>while@ (@[%a@])@ %a@]"
- (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
- annot
- print_expression exp print_substatement stat
- | DOWHILE (annot,exp, stat, _) ->
- fprintf fmt "%a@[<hov 2>do@ %a@ while@ (@[%a@])@]"
- (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
- annot
- print_substatement stat print_expression exp
- | FOR (annot,fc1, exp2, exp3, stat, _) ->
- fprintf fmt "%a@[<hov 2>for(@[%a;@ %a;@ %a@])@ %a@]"
- (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
- annot
- print_for_init fc1
- print_expression exp2
- print_expression exp3
- print_substatement stat
- | BREAK _ -> pp_print_string fmt "break;"
- | CONTINUE _ -> pp_print_string fmt "continue;"
- | RETURN (exp, _) ->
- let has_paren exp =
- match exp.expr_node with
- | PAREN _ -> true
- | _ -> false in
- fprintf fmt "return%a%a;"
- (pp_cond (not (exp.expr_node = NOTHING || has_paren exp))) "@ "
- print_expression exp
- | SWITCH (exp, stat,_) ->
- fprintf fmt "@[<hov 2>switch@ (@[%a@])@ %a@]"
- print_expression exp print_substatement stat
- | CASE (exp, stat, _) ->
- fprintf fmt "@[<2>case@ %a:@ %a@]"
- print_expression exp print_substatement stat
- | CASERANGE (expl, exph, stat, _) ->
- fprintf fmt "@[<2>case@ %a@;...@;%a:@ %a@]"
- print_expression expl
- print_expression exph
- print_substatement stat
- | DEFAULT (stat,_) ->
- fprintf fmt "@[<2>default:@ %a@]" print_substatement stat
- | LABEL (name, stat, _) ->
- fprintf fmt "@.@[<2>%s:@ %a@]" name print_substatement stat
- | GOTO (name, _) -> fprintf fmt "goto %s;" name
- | COMPGOTO (exp, _) ->
- fprintf fmt "goto@ @[*%a@];" print_expression exp
- | DEFINITION d -> print_def fmt d
- | ASM (attrs, tlist, details, _) ->
- let print_asm_operand fmt (_identop,cnstr, e) =
- fprintf fmt "@[%s@ (@[%a@])@]" cnstr print_expression e
- in
- if !msvcMode then begin
- fprintf fmt "__asm@ {@[%a@]}"
- (pp_list ~sep:"@\n" pp_print_string) tlist
- end else begin
- let print_details
- fmt { aoutputs = outs; ainputs = ins; aclobbers = clobs } =
- pp_list ~sep:",@ " print_asm_operand fmt outs;
- pp_cond (ins<>[]||clobs<>[]) fmt ":@ ";
- pp_list ~sep:",@ " print_asm_operand fmt ins;
- pp_cond (clobs<>[]) fmt ":@ ";
- pp_list ~sep:",@ " pp_print_string fmt clobs
- in
- fprintf fmt "@[__asm__%a@;(@[%a%a])@]"
- print_attributes attrs
- (pp_list ~sep:"@ " pp_print_string) tlist
- (pp_opt ~pre:":@ " print_details) details
- end
- | THROW(e,_) ->
- fprintf fmt "@[<hov 2>throw%a@]"
- (Pretty_utils.pp_opt ~pre:" (@;" ~suf:")" print_expression) e
- | TRY_CATCH(s,l,_) ->
- let print_one_catch fmt (e,s) =
- fprintf fmt "@[<v 2>@[catch %a {@]@;%a@]@;}@;"
- (Pretty_utils.pp_opt print_single_name) e
- print_statement s
+ NOP _ -> pp_print_string fmt ";"
+ | COMPUTATION (exp,_) -> fprintf fmt "%a;" print_expression exp
+ | BLOCK (blk, _,_) -> print_block fmt blk
+ | SEQUENCE (s1, s2,_) ->
+ fprintf fmt "%a;@ %a" print_statement s1 print_statement s2
+ | IF (exp, s1, s2, _) ->
+ fprintf fmt "@[<hov 2>if@ (@[%a@])@ %a@."
+ print_expression exp print_substatement s1;
+ (match s2.stmt_node with
+ | NOP(_) -> fprintf fmt "@]"
+ | _ -> fprintf fmt "@ else@ %a@]" print_substatement s2)
+ | WHILE (annot,exp, stat,_) ->
+ fprintf fmt "%a@[<hov 2>while@ (@[%a@])@ %a@]"
+ (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
+ annot
+ print_expression exp print_substatement stat
+ | DOWHILE (annot,exp, stat, _) ->
+ fprintf fmt "%a@[<hov 2>do@ %a@ while@ (@[%a@])@]"
+ (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
+ annot
+ print_substatement stat print_expression exp
+ | FOR (annot,fc1, exp2, exp3, stat, _) ->
+ fprintf fmt "%a@[<hov 2>for(@[%a;@ %a;@ %a@])@ %a@]"
+ (pp_list ~pre:"/*@@ @[" ~sep:"@\n" ~suf:"@]*/" print_code_annot)
+ annot
+ print_for_init fc1
+ print_expression exp2
+ print_expression exp3
+ print_substatement stat
+ | BREAK _ -> pp_print_string fmt "break;"
+ | CONTINUE _ -> pp_print_string fmt "continue;"
+ | RETURN (exp, _) ->
+ let has_paren exp =
+ match exp.expr_node with
+ | PAREN _ -> true
+ | _ -> false in
+ fprintf fmt "return%a%a;"
+ (pp_cond (not (exp.expr_node = NOTHING || has_paren exp))) "@ "
+ print_expression exp
+ | SWITCH (exp, stat,_) ->
+ fprintf fmt "@[<hov 2>switch@ (@[%a@])@ %a@]"
+ print_expression exp print_substatement stat
+ | CASE (exp, stat, _) ->
+ fprintf fmt "@[<2>case@ %a:@ %a@]"
+ print_expression exp print_substatement stat
+ | CASERANGE (expl, exph, stat, _) ->
+ fprintf fmt "@[<2>case@ %a@;...@;%a:@ %a@]"
+ print_expression expl
+ print_expression exph
+ print_substatement stat
+ | DEFAULT (stat,_) ->
+ fprintf fmt "@[<2>default:@ %a@]" print_substatement stat
+ | LABEL (name, stat, _) ->
+ fprintf fmt "@.@[<2>%s:@ %a@]" name print_substatement stat
+ | GOTO (name, _) -> fprintf fmt "goto %s;" name
+ | COMPGOTO (exp, _) ->
+ fprintf fmt "goto@ @[*%a@];" print_expression exp
+ | DEFINITION d -> print_def fmt d
+ | ASM (attrs, tlist, details, _) ->
+ let print_asm_operand fmt (_identop,cnstr, e) =
+ fprintf fmt "@[%s@ (@[%a@])@]" cnstr print_expression e
+ in
+ if !msvcMode then begin
+ fprintf fmt "__asm@ {@[%a@]}"
+ (pp_list ~sep:"@\n" pp_print_string) tlist
+ end else begin
+ let print_details
+ fmt { aoutputs = outs; ainputs = ins; aclobbers = clobs } =
+ pp_list ~sep:",@ " print_asm_operand fmt outs;
+ pp_cond (ins<>[]||clobs<>[]) fmt ":@ ";
+ pp_list ~sep:",@ " print_asm_operand fmt ins;
+ pp_cond (clobs<>[]) fmt ":@ ";
+ pp_list ~sep:",@ " pp_print_string fmt clobs
in
- fprintf fmt "@[<v 2>@[try %a {@]@;%a@]@;}@;"
+ fprintf fmt "@[__asm__%a@;(@[%a%a])@]"
+ print_attributes attrs
+ (pp_list ~sep:"@ " pp_print_string) tlist
+ (pp_opt ~pre:":@ " print_details) details
+ end
+ | THROW(e,_) ->
+ fprintf fmt "@[<hov 2>throw%a@]"
+ (Pretty_utils.pp_opt ~pre:" (@;" ~suf:")" print_expression) e
+ | TRY_CATCH(s,l,_) ->
+ let print_one_catch fmt (e,s) =
+ fprintf fmt "@[<v 2>@[catch %a {@]@;%a@]@;}@;"
+ (Pretty_utils.pp_opt print_single_name) e
print_statement s
- (Pretty_utils.pp_list ~sep:"@;" print_one_catch) l
- | TRY_FINALLY (b, h, _) ->
- fprintf fmt "__try@ @[%a@]@ __finally@ @[%a@]"
- print_block b print_block h
- | TRY_EXCEPT (b, e, h, _) ->
- fprintf fmt "__try@ @[%a@]@ __except(@[%a@])@ @[%a@]"
- print_block b print_expression e print_block h
- | CODE_ANNOT (a, _) ->
- fprintf fmt "/*@@@ @[%a@]@ */"
- Logic_print.print_code_annot a
- | CODE_SPEC (a, _) ->
- fprintf fmt "/*@@@ @[%a@]@ */" Logic_print.print_spec a
+ in
+ fprintf fmt "@[<v 2>@[try %a {@]@;%a@]@;}@;"
+ print_statement s
+ (Pretty_utils.pp_list ~sep:"@;" print_one_catch) l
+ | TRY_FINALLY (b, h, _) ->
+ fprintf fmt "__try@ @[%a@]@ __finally@ @[%a@]"
+ print_block b print_block h
+ | TRY_EXCEPT (b, e, h, _) ->
+ fprintf fmt "__try@ @[%a@]@ __except(@[%a@])@ @[%a@]"
+ print_block b print_expression e print_block h
+ | CODE_ANNOT (a, _) ->
+ fprintf fmt "/*@@@ @[%a@]@ */"
+ Logic_print.print_code_annot a
+ | CODE_SPEC (a, _) ->
+ fprintf fmt "/*@@@ @[%a@]@ */" Logic_print.print_spec a
and print_block fmt blk =
fprintf fmt "@ {@ @[<hov>%a%a%a@]@ }"
@@ -533,27 +533,27 @@ and print_substatement fmt stat =
IF _
| SEQUENCE _
| DOWHILE _ ->
- fprintf fmt "@ {@ @[%a@]@ }" print_statement stat
+ fprintf fmt "@ {@ @[%a@]@ }" print_statement stat
| _ ->
- print_statement fmt stat
+ print_statement fmt stat
(*
** GCC Attributes
*)
and print_attribute fmt (name,args) =
match args with
- [] -> pp_print_string fmt name
- | _ ->
- let cond = name = "__attribute__" in
- let print_args fmt = function
- [{expr_node = VARIABLE "aconst"}] ->
- pp_print_string fmt "const"
- | [{expr_node = VARIABLE "restrict"}] ->
- pp_print_string fmt "restrict"
- | args -> pp_list ~sep:",@ " print_expression fmt args
- in
- fprintf fmt "%s(%a@[%a@]%a)"
- name (pp_cond cond) "(" print_args args (pp_cond cond) ")"
+ [] -> pp_print_string fmt name
+ | _ ->
+ let cond = name = "__attribute__" in
+ let print_args fmt = function
+ [{expr_node = VARIABLE "aconst"}] ->
+ pp_print_string fmt "const"
+ | [{expr_node = VARIABLE "restrict"}] ->
+ pp_print_string fmt "restrict"
+ | args -> pp_list ~sep:",@ " print_expression fmt args
+ in
+ fprintf fmt "%s(%a@[%a@]%a)"
+ name (pp_cond cond) "(" print_args args (pp_cond cond) ")"
(* Print attributes. *)
and print_attributes fmt attrs =
@@ -566,11 +566,11 @@ and print_defs fmt defs =
let prev = ref false in
List.iter
(fun (ghost,def) ->
- (match def with
- DECDEF _ -> prev := false
- | _ ->
- if not !prev then pp_print_newline fmt ();
- prev := true);
+ (match def with
+ DECDEF _ -> prev := false
+ | _ ->
+ if not !prev then pp_print_newline fmt ();
+ prev := true);
if ghost then fprintf fmt "/*@@@ @[ghost@ %a@]@ */" print_def def
else print_def fmt def
)
@@ -580,54 +580,54 @@ and print_def fmt def =
Cil_const.CurrentLoc.set (Cabshelper.get_definitionloc def);
match def with
FUNDEF (spec, proto, body, loc, _) ->
- if !printCounters then begin
- try
- let fname =
- match proto with
- (_, (n, _, _, _)) -> n
- in
- print_def fmt (DECDEF (None,([SpecType Tint],
- [(fname ^ "__counter", JUSTBASE, [], loc),
- NO_INIT]), loc));
- with Not_found ->
- pp_print_string fmt "/* can't print the counter */"
- end;
- fprintf fmt "@[%a%a@\n%a@]@\n"
- (Pretty_utils.pp_opt ~pre:"/*@@ @[" ~suf:"@]@\n */@\n"
- (fun fmt (spec,_) -> Logic_print.print_spec fmt spec))
- spec
- print_single_name proto print_block body
+ if !printCounters then begin
+ try
+ let fname =
+ match proto with
+ (_, (n, _, _, _)) -> n
+ in
+ print_def fmt (DECDEF (None,([SpecType Tint],
+ [(fname ^ "__counter", JUSTBASE, [], loc),
+ NO_INIT]), loc));
+ with Not_found ->
+ pp_print_string fmt "/* can't print the counter */"
+ end;
+ fprintf fmt "@[%a%a@\n%a@]@\n"
+ (Pretty_utils.pp_opt ~pre:"/*@@ @[" ~suf:"@]@\n */@\n"
+ (fun fmt (spec,_) -> Logic_print.print_spec fmt spec))
+ spec
+ print_single_name proto print_block body
| DECDEF (spec,names, _) ->
- fprintf fmt "@[%a%a;@]@\n"
- (Pretty_utils.pp_opt ~pre:"/*@@ @[" ~suf:"@]@\n */@\n"
- (fun fmt (spec,_) -> Logic_print.print_spec fmt spec))
- spec
- print_init_name_group names
+ fprintf fmt "@[%a%a;@]@\n"
+ (Pretty_utils.pp_opt ~pre:"/*@@ @[" ~suf:"@]@\n */@\n"
+ (fun fmt (spec,_) -> Logic_print.print_spec fmt spec))
+ spec
+ print_init_name_group names
| TYPEDEF (names, _) ->
- fprintf fmt "@[%a;@\n@]" print_name_group names
+ fprintf fmt "@[%a;@\n@]" print_name_group names
| ONLYTYPEDEF (specs, _) ->
- fprintf fmt "@[%a;@\n@]" print_specifiers specs
+ fprintf fmt "@[%a;@\n@]" print_specifiers specs
| GLOBASM (asm, _) ->
- fprintf fmt "@[__asm__(%s);@\n@]" asm
+ fprintf fmt "@[__asm__(%s);@\n@]" asm
| GLOBANNOT (annot) ->
- fprintf fmt "@[/*@@@ @[%a@]@ */@]@\n"
- (pp_list ~sep:"@\n" Logic_print.print_decl) annot
+ fprintf fmt "@[/*@@@ @[%a@]@ */@]@\n"
+ (pp_list ~sep:"@\n" Logic_print.print_decl) annot
| CUSTOM _ -> fprintf fmt "<custom annot>"
| PRAGMA (a,_) ->
- fprintf fmt "@[#pragma %a@]@\n" print_expression a
+ fprintf fmt "@[#pragma %a@]@\n" print_expression a
| LINKAGE (n, _, dl) ->
- fprintf fmt "@[<2>extern@ %s@ {%a@;}@]" n (pp_list print_def) dl
+ fprintf fmt "@[<2>extern@ %s@ {%a@;}@]" n (pp_list print_def) dl
(* print abstrac_syntax -> ()
-** Pretty printing the given abstract syntax program.
+ ** Pretty printing the given abstract syntax program.
*)
let printFile fmt ((_fname, defs) : file) = print_defs fmt defs
diff --git a/src/kernel_services/ast_printing/cprint.mli b/src/kernel_services/ast_printing/cprint.mli
index 7efec3e0231c69e25d1592aad459df60a4ad991c..9ea4e8d86a6bc14e672b25b7f3937ca9fd636787 100644
--- a/src/kernel_services/ast_printing/cprint.mli
+++ b/src/kernel_services/ast_printing/cprint.mli
@@ -51,7 +51,7 @@ val printCounters : bool ref
val printComments : bool ref
val get_operator : Cabs.expression -> (string * int)
-
+
val print_specifiers : Format.formatter -> Cabs.specifier -> unit
val print_type_spec : Format.formatter -> Cabs.typeSpecifier -> unit
val print_struct_name_attr :
diff --git a/src/kernel_services/ast_printing/description.ml b/src/kernel_services/ast_printing/description.ml
index c4fe1d6cdfd06e13ccd79cae4b4d75a690744bb7..6544c2ba0cbb5055d14e179024bd7821292d189b 100644
--- a/src/kernel_services/ast_printing/description.ml
+++ b/src/kernel_services/ast_printing/description.ml
@@ -33,74 +33,74 @@ let pp_opt doit pp fmt x = if doit then pp fmt x
let goto_stmt stmt =
let rec goto_label = function
| [] -> Printf.sprintf "s%04d" stmt.sid
- | Label(a,_,true)::_ -> a
+ | Label(a,_,true)::_ -> a
| _::labels -> goto_label labels
in goto_label stmt.labels
let rec stmt_labels = function
| Label(a,_,true) :: ls -> a :: stmt_labels ls
| Label _ :: ls -> stmt_labels ls
- | Case(e,_) :: ls ->
- let cvalue = (Cil.constFold true e) in
- Format.asprintf "case %a" Printer.pp_exp cvalue
- :: stmt_labels ls
+ | Case(e,_) :: ls ->
+ let cvalue = (Cil.constFold true e) in
+ Format.asprintf "case %a" Printer.pp_exp cvalue
+ :: stmt_labels ls
| Default _ :: ls ->
- "default" :: stmt_labels ls
+ "default" :: stmt_labels ls
| [] -> []
let pp_labels fmt stmt =
match stmt_labels stmt.labels with
- | [] -> ()
- | ls -> Format.fprintf fmt " '%s'" (String.concat "," ls)
+ | [] -> ()
+ | ls -> Format.fprintf fmt " '%s'" (String.concat "," ls)
let pp_idpred kloc fmt idpred =
let np = idpred.ip_content in
- if np.pred_name <> []
+ if np.pred_name <> []
then Format.fprintf fmt " '%s'" (String.concat "," np.pred_name)
else pp_kloc kloc fmt np.pred_loc
let pp_allocation kloc fmt (allocation:identified_term list) =
if allocation = [] then Format.fprintf fmt "nothing"
else
- let names =
+ let names =
List.fold_left
- (fun names x -> names @ x.it_content.term_name)
- [] allocation in
+ (fun names x -> names @ x.it_content.term_name)
+ [] allocation in
match names with
- | [] ->
- if kloc then
- let x = List.hd allocation in
- Format.fprintf fmt "(%a)" pp_loc x.it_content.term_loc
- else Format.fprintf fmt "..."
- | _ ->
- Format.fprintf fmt "'%s'" (String.concat "," names)
+ | [] ->
+ if kloc then
+ let x = List.hd allocation in
+ Format.fprintf fmt "(%a)" pp_loc x.it_content.term_loc
+ else Format.fprintf fmt "..."
+ | _ ->
+ Format.fprintf fmt "'%s'" (String.concat "," names)
let pp_region kloc fmt (region:from list) =
if region = [] then Format.fprintf fmt "nothing"
else
- let names =
+ let names =
List.fold_left
- (fun names (x,_) -> names @ x.it_content.term_name)
- [] region in
+ (fun names (x,_) -> names @ x.it_content.term_name)
+ [] region in
match names with
- | [] ->
- if kloc then
- let x = fst (List.hd region) in
- Format.fprintf fmt "(%a)" pp_loc x.it_content.term_loc
- else Format.fprintf fmt "..."
- | _ ->
- Format.fprintf fmt "'%s'" (String.concat "," names)
+ | [] ->
+ if kloc then
+ let x = fst (List.hd region) in
+ Format.fprintf fmt "(%a)" pp_loc x.it_content.term_loc
+ else Format.fprintf fmt "..."
+ | _ ->
+ Format.fprintf fmt "'%s'" (String.concat "," names)
let pp_bhv fmt bhv =
- if not (Cil.is_default_behavior bhv) then
+ if not (Cil.is_default_behavior bhv) then
Format.fprintf fmt " for '%s'" bhv.b_name
let pp_bhvs fmt = function
| [] -> ()
| b::bs ->
- Format.fprintf fmt " @[<hov 0>'%s'" b ;
- List.iter (fun b -> Format.fprintf fmt ",@ '%s'" b) bs ;
- Format.fprintf fmt "@]"
+ Format.fprintf fmt " @[<hov 0>'%s'" b ;
+ List.iter (fun b -> Format.fprintf fmt ",@ '%s'" b) bs ;
+ Format.fprintf fmt "@]"
let pp_for fmt = function
| [] -> ()
@@ -112,42 +112,42 @@ let pp_named fmt nx =
let pp_code_annot fmt ca =
match ca.annot_content with
- | AAssert(bs,np) -> Format.fprintf fmt "assertion%a%a" pp_for bs pp_named np
- | AInvariant(bs,_,np) ->
- Format.fprintf fmt "invariant%a%a" pp_for bs pp_named np
- | AAssigns(bs,_) -> Format.fprintf fmt "assigns%a" pp_for bs
- | AAllocation(bs,_) -> Format.fprintf fmt "allocates_frees%a" pp_for bs
- | APragma _ -> Format.pp_print_string fmt "pragma"
- | AVariant _ -> Format.pp_print_string fmt "variant"
- | AStmtSpec _ -> Format.pp_print_string fmt "block contract"
- | AExtended _ -> Format.pp_print_string fmt "extension"
+ | AAssert(bs,np) -> Format.fprintf fmt "assertion%a%a" pp_for bs pp_named np
+ | AInvariant(bs,_,np) ->
+ Format.fprintf fmt "invariant%a%a" pp_for bs pp_named np
+ | AAssigns(bs,_) -> Format.fprintf fmt "assigns%a" pp_for bs
+ | AAllocation(bs,_) -> Format.fprintf fmt "allocates_frees%a" pp_for bs
+ | APragma _ -> Format.pp_print_string fmt "pragma"
+ | AVariant _ -> Format.pp_print_string fmt "variant"
+ | AStmtSpec _ -> Format.pp_print_string fmt "block contract"
+ | AExtended _ -> Format.pp_print_string fmt "extension"
let pp_stmt kloc fmt stmt =
match stmt.skind with
- | Instr (Local_init (v,_,loc)) ->
- Format.fprintf fmt "initialization of '%s'%a" v.vname (pp_kloc kloc) loc
- | Instr (Call(_,{enode=Lval(Var v,_)},_,loc)) ->
- Format.fprintf fmt "call '%s'%a" v.vname (pp_kloc kloc) loc
- | Instr (Set(_,_,loc)|Call(_,_,_,loc)) ->
- Format.fprintf fmt "instruction%a" (pp_kloc kloc) loc
- | Instr (Asm(_,_,_,loc)) ->
- Format.fprintf fmt "assembly%a%a" pp_labels stmt (pp_kloc kloc) loc
- | Instr (Skip(_,loc)) ->
- Format.fprintf fmt "program point%a%a" pp_labels stmt (pp_kloc kloc) (loc,loc)
- | Instr (Code_annot(ca,loc)) ->
- Format.fprintf fmt "%a%a" pp_code_annot ca (pp_kloc kloc) loc
- | Return(_,loc) -> Format.fprintf fmt "return%a" (pp_kloc kloc) loc
- | Goto(s,loc) -> Format.fprintf fmt "goto %s%a" (goto_stmt !s) (pp_kloc kloc) loc
- | Break loc -> Format.fprintf fmt "break%a" (pp_kloc kloc) loc
- | Continue loc -> Format.fprintf fmt "continue%a" (pp_kloc kloc) loc
- | If(_,_,_,loc) -> Format.fprintf fmt "if-then-else%a" (pp_kloc kloc) loc
- | Switch(_,_,_,loc) -> Format.fprintf fmt "switch%a" (pp_kloc kloc) loc
- | Loop(_,_,loc,_,_) -> Format.fprintf fmt "loop%a" (pp_kloc kloc) loc
- | Block _ -> Format.fprintf fmt "block%a" pp_labels stmt
- | UnspecifiedSequence _ -> Format.fprintf fmt "instruction%a" pp_labels stmt
- | Throw(_,loc) -> Format.fprintf fmt "throw%a" (pp_kloc kloc) loc
- | TryFinally(_,_,loc) | TryExcept(_,_,_,loc) | TryCatch(_,_,loc)->
- Format.fprintf fmt "try-catch%a" (pp_kloc kloc) loc
+ | Instr (Local_init (v,_,loc)) ->
+ Format.fprintf fmt "initialization of '%s'%a" v.vname (pp_kloc kloc) loc
+ | Instr (Call(_,{enode=Lval(Var v,_)},_,loc)) ->
+ Format.fprintf fmt "call '%s'%a" v.vname (pp_kloc kloc) loc
+ | Instr (Set(_,_,loc)|Call(_,_,_,loc)) ->
+ Format.fprintf fmt "instruction%a" (pp_kloc kloc) loc
+ | Instr (Asm(_,_,_,loc)) ->
+ Format.fprintf fmt "assembly%a%a" pp_labels stmt (pp_kloc kloc) loc
+ | Instr (Skip(_,loc)) ->
+ Format.fprintf fmt "program point%a%a" pp_labels stmt (pp_kloc kloc) (loc,loc)
+ | Instr (Code_annot(ca,loc)) ->
+ Format.fprintf fmt "%a%a" pp_code_annot ca (pp_kloc kloc) loc
+ | Return(_,loc) -> Format.fprintf fmt "return%a" (pp_kloc kloc) loc
+ | Goto(s,loc) -> Format.fprintf fmt "goto %s%a" (goto_stmt !s) (pp_kloc kloc) loc
+ | Break loc -> Format.fprintf fmt "break%a" (pp_kloc kloc) loc
+ | Continue loc -> Format.fprintf fmt "continue%a" (pp_kloc kloc) loc
+ | If(_,_,_,loc) -> Format.fprintf fmt "if-then-else%a" (pp_kloc kloc) loc
+ | Switch(_,_,_,loc) -> Format.fprintf fmt "switch%a" (pp_kloc kloc) loc
+ | Loop(_,_,loc,_,_) -> Format.fprintf fmt "loop%a" (pp_kloc kloc) loc
+ | Block _ -> Format.fprintf fmt "block%a" pp_labels stmt
+ | UnspecifiedSequence _ -> Format.fprintf fmt "instruction%a" pp_labels stmt
+ | Throw(_,loc) -> Format.fprintf fmt "throw%a" (pp_kloc kloc) loc
+ | TryFinally(_,_,loc) | TryExcept(_,_,_,loc) | TryCatch(_,_,loc)->
+ Format.fprintf fmt "try-catch%a" (pp_kloc kloc) loc
let pp_stmt_loc kloc fmt s = Format.fprintf fmt " at %a" (pp_stmt kloc) s
@@ -155,22 +155,22 @@ let pp_kinstr kloc fmt = function
| Kglobal -> () | Kstmt s -> pp_stmt_loc kloc fmt s
let pp_predicate fmt = function
- | PKRequires bhv ->
- Format.fprintf fmt "Pre-condition%a" pp_bhv bhv
- | PKAssumes bhv ->
- Format.fprintf fmt "Assumption%a" pp_bhv bhv
+ | PKRequires bhv ->
+ Format.fprintf fmt "Pre-condition%a" pp_bhv bhv
+ | PKAssumes bhv ->
+ Format.fprintf fmt "Assumption%a" pp_bhv bhv
| PKEnsures(bhv,Normal) ->
- Format.fprintf fmt "Post-condition%a" pp_bhv bhv
+ Format.fprintf fmt "Post-condition%a" pp_bhv bhv
| PKEnsures(bhv,Breaks) ->
- Format.fprintf fmt "Breaking-condition%a" pp_bhv bhv
+ Format.fprintf fmt "Breaking-condition%a" pp_bhv bhv
| PKEnsures(bhv,Continues) ->
- Format.fprintf fmt "Continue-condition%a" pp_bhv bhv
+ Format.fprintf fmt "Continue-condition%a" pp_bhv bhv
| PKEnsures(bhv,Returns) ->
- Format.fprintf fmt "Return-condition%a" pp_bhv bhv
+ Format.fprintf fmt "Return-condition%a" pp_bhv bhv
| PKEnsures(bhv,Exits) ->
- Format.fprintf fmt "Exit-condition%a" pp_bhv bhv
+ Format.fprintf fmt "Exit-condition%a" pp_bhv bhv
| PKTerminates ->
- Format.fprintf fmt "Termination-condition"
+ Format.fprintf fmt "Termination-condition"
let pp_kf_context kfopt fmt kf =
match kfopt with
@@ -206,8 +206,10 @@ let pp_active fmt active =
~pre:" under active behaviors" ~sep:"," Format.pp_print_string fmt
(Datatype.String.Set.elements active)
-let pp_acsl_extension fmt (_,s,_,_) =
- Format.fprintf fmt "%s" s
+let pp_capitalize fmt s =
+ Format.pp_print_string fmt (Transitioning.String.capitalize_ascii s)
+
+let pp_acsl_extension fmt (_,s,_,_,_) = pp_capitalize fmt s
let rec pp_prop kfopt kiopt kloc fmt = function
| IPAxiom (s,_,_,_,_) -> Format.fprintf fmt "Axiom '%s'" s
@@ -216,87 +218,90 @@ let rec pp_prop kfopt kiopt kloc fmt = function
| IPGlobalInvariant (s,_,_) -> Format.fprintf fmt "Global invariant '%s'" s
| IPAxiomatic (s,_) -> Format.fprintf fmt "Axiomatic '%s'" s
| IPOther(s,le) ->
- Format.fprintf fmt "%s%a" s (pp_other_loc kfopt kiopt kloc) le
+ Format.fprintf fmt "%a%a" pp_capitalize s (pp_other_loc kfopt kiopt kloc) le
| IPPredicate(kind,kf,Kglobal,idpred) ->
- Format.fprintf fmt "%a%a%a"
- pp_predicate kind
- (pp_idpred kloc) idpred
+ Format.fprintf fmt "%a%a%a"
+ pp_predicate kind
+ (pp_idpred kloc) idpred
(pp_context kfopt) (Some kf)
| IPPredicate(kind,_,ki,idpred) ->
- Format.fprintf fmt "%a%a%a"
- pp_predicate kind
- (pp_idpred kloc) idpred
+ Format.fprintf fmt "%a%a%a"
+ pp_predicate kind
+ (pp_idpred kloc) idpred
(pp_kinstr kloc) ki
- | IPExtended(le,(_,_,loc,_ as pred)) ->
+ | IPExtended(le,(_,_,loc,_,_ as ext)) ->
Format.fprintf fmt "%a%a"
- pp_acsl_extension pred
+ pp_acsl_extension ext
(pp_extended_loc kfopt kiopt kloc) (loc,le)
| IPBehavior(_,ki, active, bhv) ->
if Cil.is_default_behavior bhv then
Format.fprintf fmt "Default behavior%a%a"
(pp_opt kiopt (pp_kinstr kloc)) ki (pp_opt kiopt pp_active) active
else
- Format.fprintf fmt "Behavior '%s'%a"
- bhv.b_name
- (pp_opt kiopt (pp_kinstr kloc)) ki
+ Format.fprintf fmt "Behavior '%s'%a"
+ bhv.b_name
+ (pp_opt kiopt (pp_kinstr kloc)) ki
| IPComplete(_,ki,active, bs) ->
- Format.fprintf fmt "Complete behaviors%a%a%a"
+ Format.fprintf fmt "Complete behaviors%a%a%a"
pp_bhvs bs
(pp_opt kiopt (pp_kinstr kloc)) ki (pp_opt kiopt pp_active) active
| IPDisjoint(_,ki,active, bs) ->
- Format.fprintf fmt "Disjoint behaviors%a%a%a"
+ Format.fprintf fmt "Disjoint behaviors%a%a%a"
pp_bhvs bs
(pp_opt kiopt (pp_kinstr kloc)) ki
(pp_opt kiopt pp_active) active
| IPCodeAnnot(_,_,{annot_content=AAssert(bs,np)}) ->
- Format.fprintf fmt "Assertion%a%a%a"
- pp_for bs
- pp_named np
+ Format.fprintf fmt "Assertion%a%a%a"
+ pp_for bs
+ pp_named np
(pp_kloc kloc) np.pred_loc
| IPCodeAnnot(_,_,{annot_content=AInvariant(bs,_,np)}) ->
- Format.fprintf fmt "Invariant%a%a%a"
- pp_for bs
- pp_named np
+ Format.fprintf fmt "Invariant%a%a%a"
+ pp_for bs
+ pp_named np
(pp_kloc kloc) np.pred_loc
+ | IPCodeAnnot(_,stmt,{annot_content=AExtended(bs,_,(_,clause,_,_,_))}) ->
+ Format.fprintf fmt "%a%a %a"
+ pp_capitalize clause pp_for bs (pp_stmt kloc) stmt
| IPCodeAnnot(_,stmt,_) ->
Format.fprintf fmt "Annotation %a" (pp_stmt kloc) stmt
| IPAllocation(kf,Kglobal,Id_contract (_,bhv),(frees,allocates)) ->
- Format.fprintf fmt "Frees/Allocates%a %a/%a %a"
- pp_bhv bhv
+ Format.fprintf fmt "Frees/Allocates%a %a/%a %a"
+ pp_bhv bhv
(pp_allocation kloc) frees
(pp_allocation kloc) allocates
(pp_context kfopt) (Some kf)
| IPAssigns(kf,Kglobal,Id_contract(_, bhv),region) ->
- Format.fprintf fmt "Assigns%a %a%a"
- pp_bhv bhv
- (pp_region kloc) region
- (pp_context kfopt) (Some kf)
+ Format.fprintf fmt "Assigns%a %a%a"
+ pp_bhv bhv
+ (pp_region kloc) region
+ (pp_context kfopt) (Some kf)
| IPFrom (kf,Kglobal,Id_contract(_,bhv),depend) ->
Format.fprintf fmt "Froms%a %a%a"
- pp_bhv bhv
- (pp_region kloc) [depend]
- (pp_context kfopt) (Some kf)
+ pp_bhv bhv
+ (pp_region kloc) [depend]
+ (pp_context kfopt) (Some kf)
| IPAllocation(_,ki,Id_contract (active,bhv),(frees,allocates)) ->
- Format.fprintf fmt "Frees/Allocates%a %a/%a %a%a"
- pp_bhv bhv
+ Format.fprintf fmt "Frees/Allocates%a %a/%a %a%a"
+ pp_bhv bhv
(pp_allocation kloc) frees
(pp_allocation kloc) allocates
(pp_opt kiopt (pp_kinstr kloc)) ki
(pp_opt kiopt pp_active) active
| IPAssigns(_,ki,Id_contract (active,bhv),region) ->
Format.fprintf fmt "Assigns%a %a%a%a"
- pp_bhv bhv
- (pp_region kloc) region
+ pp_bhv bhv
+ (pp_region kloc) region
(pp_opt kiopt (pp_kinstr kloc)) ki
(pp_opt kiopt pp_active) active
| IPFrom (_,ki,Id_contract (active,bhv),depend) ->
- Format.fprintf fmt "Froms%a %a%a%a"
- pp_bhv bhv
- (pp_region kloc) [depend]
+ Format.fprintf fmt "Froms%a %a%a%a"
+ pp_bhv bhv
+ (pp_region kloc) [depend]
(pp_opt kiopt (pp_kinstr kloc)) ki
(pp_opt kiopt pp_active) active
| IPAllocation(_,_,Id_loop _,(frees,allocates)) ->
- Format.fprintf fmt "Loop frees%a Loop allocates%a"
+ Format.fprintf fmt "Loop frees%a Loop allocates%a"
(pp_allocation kloc) frees
(pp_allocation kloc) allocates
| IPAssigns(_,_,Id_loop _,region) ->
@@ -307,14 +312,14 @@ let rec pp_prop kfopt kiopt kloc fmt = function
Format.fprintf fmt "Recursion variant"
| IPDecrease(_,Kstmt stmt,_,_) ->
Format.fprintf fmt "Loop variant at %a" (pp_stmt kloc) stmt
- | IPReachable (None, Kglobal, Before) ->
+ | IPReachable (None, Kglobal, Before) ->
(* print "Unreachable": it seems that it is what the user want to see *)
Format.fprintf fmt "Unreachable entry point"
| IPReachable (None, Kglobal, After)
| IPReachable (None, Kstmt _, _) -> assert false
| IPReachable (Some _, Kstmt stmt, ba) ->
(* print "Unreachable": it seems that it is what the user want to see *)
- Format.fprintf fmt "Unreachable %a%s"
+ Format.fprintf fmt "Unreachable %a%s"
(pp_stmt kloc) stmt
(match ba with Before -> "" | After -> " (after it)")
| IPReachable (Some kf, Kglobal, _) ->
@@ -343,18 +348,18 @@ let to_string pp elt =
Buffer.contents b
let code_annot_kind_and_node code_annot = match code_annot.annot_content with
- | AAssert (_, {pred_content; pred_name}) ->
- let kind = match Alarms.find code_annot with
- | Some alarm -> Alarms.get_name alarm
- | None ->
- if List.exists ((=) "missing_return") pred_name
- then "missing_return"
- else "user assertion"
- in
- Some (kind, to_string Printer.pp_predicate_node pred_content)
- | AInvariant (_, _, {pred_content}) ->
- Some ("loop invariant", to_string Printer.pp_predicate_node pred_content)
- | _ -> None
+ | AAssert (_, {pred_content; pred_name}) ->
+ let kind = match Alarms.find code_annot with
+ | Some alarm -> Alarms.get_name alarm
+ | None ->
+ if List.exists ((=) "missing_return") pred_name
+ then "missing_return"
+ else "user assertion"
+ in
+ Some (kind, to_string Printer.pp_predicate_node pred_content)
+ | AInvariant (_, _, {pred_content}) ->
+ Some ("loop invariant", to_string Printer.pp_predicate_node pred_content)
+ | _ -> None
let property_kind_and_node property =
let default kind = Some (kind, to_string Property.pretty property) in
@@ -414,13 +419,13 @@ let cmp_order a b = match a , b with
| F _ , _ -> (-1)
| _ , F _ -> 1
| B a , B b ->
- begin
- match Cil.is_default_behavior a , Cil.is_default_behavior b with
- | true , true -> 0
- | true , false -> (-1)
- | false , true -> 1
- | false , false -> String.compare a.b_name b.b_name
- end
+ begin
+ match Cil.is_default_behavior a , Cil.is_default_behavior b with
+ | true , true -> 0
+ | true , false -> (-1)
+ | false , true -> 1
+ | false , false -> String.compare a.b_name b.b_name
+ end
| B _ , _ -> (-1)
| _ , B _ -> 1
| K a , K b -> Cil_datatype.Kinstr.compare a b
@@ -433,8 +438,8 @@ let rec cmp xs ys = match xs,ys with
| [],_ -> (-1)
| _,[] -> 1
| x::xs,y::ys ->
- let c = cmp_order x y in
- if c<>0 then c else cmp xs ys
+ let c = cmp_order x y in
+ if c<>0 then c else cmp xs ys
let kind_order = function
| PKRequires bhv -> [B bhv;I 1]
@@ -447,8 +452,8 @@ let kind_order = function
| PKTerminates -> [I 8]
let named_order xs = List.map (fun x -> S x) xs
-let for_order k = function
- | [] -> [I k]
+let for_order k = function
+ | [] -> [I k]
| bs -> I (succ k) :: named_order bs
let annot_order = function
| {annot_content=AAssert(bs,np)} ->
@@ -459,7 +464,7 @@ let annot_order = function
let loop_order = function
| Id_contract (active,b) -> [B b; A active]
| Id_loop _ -> []
-
+
let rec ip_order = function
| IPAxiomatic(a,_) -> [I 0;S a]
| IPAxiom(a,_,_,_,_) | IPLemma(a,_,_,_,_) -> [I 1;S a]
@@ -481,10 +486,10 @@ let rec ip_order = function
| IPPropertyInstance (kf, s, _, ip) -> [I 18; F kf; K (Kstmt s)] @ ip_order ip
| IPTypeInvariant(a,_,_,_) -> [I 19; S a]
| IPGlobalInvariant(a,_,_) -> [I 20; S a]
- | IPExtended(ELContract kf,(_,n,_,_)) -> [I 21;F kf; S n]
- | IPExtended(ELStmt (kf, stmt), (_, n, _,_)) ->
+ | IPExtended(ELContract kf,(_,n,_,_,_)) -> [I 21;F kf; S n]
+ | IPExtended(ELStmt (kf, stmt), (_,n,_,_,_)) ->
[ I 22; F kf; K (Kstmt stmt); S n]
- | IPExtended(ELGlob, (_, n, _,_)) -> [ I 23; S n]
+ | IPExtended(ELGlob, (_,n,_,_,_)) -> [ I 23; S n]
let pp_compare p q = cmp (ip_order p) (ip_order q)
diff --git a/src/kernel_services/ast_printing/description.mli b/src/kernel_services/ast_printing/description.mli
index a27280f88ac6fee91de4764000671b93f4d5b63b..6dbb4b79118b8097e34185171e0c003893378879 100644
--- a/src/kernel_services/ast_printing/description.mli
+++ b/src/kernel_services/ast_printing/description.mli
@@ -20,7 +20,7 @@
(* *)
(**************************************************************************)
-(** Describe items of Source and Properties.
+(** Describe items of Source and Properties.
@since Nitrogen-20111001 *)
open Cil_types
@@ -36,7 +36,7 @@ val pp_idpred : bool -> Format.formatter -> identified_predicate -> unit
val pp_region : bool -> Format.formatter -> from list -> unit
(** prints message "nothing" or the "'<names>'" or the "(<location>)" of the
- relation *)
+ relation *)
val pp_named: Format.formatter -> predicate -> unit
(** prints the name of a named logic structure (if any), separated by ','. *)
diff --git a/src/kernel_services/ast_printing/logic_print.ml b/src/kernel_services/ast_printing/logic_print.ml
index c81c74c97ee67bd26927d81afb46bd787b7efb7b..1de61b503727954aa7997505551792d4c91ea0c1 100644
--- a/src/kernel_services/ast_printing/logic_print.ml
+++ b/src/kernel_services/ast_printing/logic_print.ml
@@ -43,49 +43,49 @@ let rec print_logic_type name fmt typ =
| None -> (fun _ -> ())
in
match typ with
- | LTattribute (t,attr) ->
- let pname fmt =
- fprintf fmt "%a" Cil_printer.pp_attribute attr
- in
- print_logic_type (Some pname) fmt t
- | LTvoid -> fprintf fmt "void%t" pname
- | LTinteger ->
- fprintf fmt "%s%t"
- (if Kernel.Unicode.get () then Utf8_logic.integer else "integer")
- pname
- | LTreal ->
- fprintf fmt "%s%t"
- (if Kernel.Unicode.get () then Utf8_logic.real else "real")
- pname
- | LTint i -> fprintf fmt "%a%t" Cil_printer.pp_ikind i pname
- | LTfloat f -> fprintf fmt "%a%t" Cil_printer.pp_fkind f pname
- | LTarray (t,c) ->
- let pname fmt =
- fprintf fmt "%t[@[%a@]]" pname print_array_size c
- in
- print_logic_type (Some pname) fmt t
- | LTpointer t ->
- let needs_paren = match t with LTarray _ -> true | _ -> false in
- let pname fmt =
- Format.fprintf fmt "%a*%t%a"
- (pp_cond needs_paren) "(" pname (pp_cond needs_paren) ")"
- in
- print_logic_type (Some pname) fmt t
- | LTunion s -> fprintf fmt "union@ %s%t" s pname
- | LTenum s -> fprintf fmt "enum@ %s%t" s pname
- | LTstruct s -> fprintf fmt "struct@ %s%t" s pname
- | LTnamed (s,l) ->
- fprintf fmt "%s%a%t"
- s
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>"
- (print_logic_type None)) l
- pname
- | LTarrow(args,ret) ->
- let pname fmt =
- fprintf fmt "%t(@[%a@])" pname
- (pp_list ~sep:",@ " (print_logic_type None)) args
- in
- print_logic_type (Some pname) fmt ret
+ | LTattribute (t,attr) ->
+ let pname fmt =
+ fprintf fmt "%a" Cil_printer.pp_attribute attr
+ in
+ print_logic_type (Some pname) fmt t
+ | LTvoid -> fprintf fmt "void%t" pname
+ | LTinteger ->
+ fprintf fmt "%s%t"
+ (if Kernel.Unicode.get () then Utf8_logic.integer else "integer")
+ pname
+ | LTreal ->
+ fprintf fmt "%s%t"
+ (if Kernel.Unicode.get () then Utf8_logic.real else "real")
+ pname
+ | LTint i -> fprintf fmt "%a%t" Cil_printer.pp_ikind i pname
+ | LTfloat f -> fprintf fmt "%a%t" Cil_printer.pp_fkind f pname
+ | LTarray (t,c) ->
+ let pname fmt =
+ fprintf fmt "%t[@[%a@]]" pname print_array_size c
+ in
+ print_logic_type (Some pname) fmt t
+ | LTpointer t ->
+ let needs_paren = match t with LTarray _ -> true | _ -> false in
+ let pname fmt =
+ Format.fprintf fmt "%a*%t%a"
+ (pp_cond needs_paren) "(" pname (pp_cond needs_paren) ")"
+ in
+ print_logic_type (Some pname) fmt t
+ | LTunion s -> fprintf fmt "union@ %s%t" s pname
+ | LTenum s -> fprintf fmt "enum@ %s%t" s pname
+ | LTstruct s -> fprintf fmt "struct@ %s%t" s pname
+ | LTnamed (s,l) ->
+ fprintf fmt "%s%a%t"
+ s
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>"
+ (print_logic_type None)) l
+ pname
+ | LTarrow(args,ret) ->
+ let pname fmt =
+ fprintf fmt "%t(@[%a@])" pname
+ (pp_list ~sep:",@ " (print_logic_type None)) args
+ in
+ print_logic_type (Some pname) fmt ret
let print_typed_ident fmt (t,s) =
print_logic_type (Some (fun fmt -> pp_print_string fmt s)) fmt t
@@ -112,43 +112,43 @@ let get_unop_string = function
let getParenthLevel e =
match e.lexpr_node with
- | PLnamed _ -> 95
- | PLlambda _ | PLlet _ | PLrange _ -> 90
- | PLforall _ | PLexists _ -> 87
- | PLimplies _ | PLiff _ -> 85
- | PLand _ | PLor _ | PLxor _ -> 80
- | PLif _ -> 77
- | PLbinop (_,(Bbw_and | Bbw_or | Bbw_xor),_) -> 75
- | PLrepeat _ -> 72
- | PLrel _ -> 70
- | PLbinop (_,(Badd|Bsub|Blshift|Brshift),_) -> 60
- | PLbinop (_,(Bmul|Bdiv|Bmod),_) -> 40
- | PLunop ((Uamp|Uminus|Ubw_not),_) | PLcast _ | PLnot _ -> 30
- | PLcoercion _ | PLcoercionE _ -> 25
- | PLunop (Ustar,_) | PLdot _ | PLarrow _ | PLarrget _
- | PLsizeof _ | PLsizeofE _ -> 20
- | PLapp _ | PLold _ | PLat _
- | PLoffset _ | PLbase_addr _ | PLblock_length _
- | PLupdate _ | PLinitField _ | PLinitIndex _
- | PLvalid _ | PLvalid_read _ | PLvalid_function _
- | PLinitialized _ | PLdangling _
- | PLallocable _ | PLfreeable _ | PLfresh _
- | PLseparated _ | PLsubtype _ | PLunion _ | PLinter _ -> 10
- | PLvar _ | PLconstant _ | PLresult | PLnull | PLtypeof _ | PLtype _
- | PLfalse | PLtrue | PLcomprehension _ | PLempty | PLset _ | PLlist _ -> 0
+ | PLnamed _ -> 95
+ | PLlambda _ | PLlet _ | PLrange _ -> 90
+ | PLforall _ | PLexists _ -> 87
+ | PLimplies _ | PLiff _ -> 85
+ | PLand _ | PLor _ | PLxor _ -> 80
+ | PLif _ -> 77
+ | PLbinop (_,(Bbw_and | Bbw_or | Bbw_xor),_) -> 75
+ | PLrepeat _ -> 72
+ | PLrel _ -> 70
+ | PLbinop (_,(Badd|Bsub|Blshift|Brshift),_) -> 60
+ | PLbinop (_,(Bmul|Bdiv|Bmod),_) -> 40
+ | PLunop ((Uamp|Uminus|Ubw_not),_) | PLcast _ | PLnot _ -> 30
+ | PLcoercion _ | PLcoercionE _ -> 25
+ | PLunop (Ustar,_) | PLdot _ | PLarrow _ | PLarrget _
+ | PLsizeof _ | PLsizeofE _ -> 20
+ | PLapp _ | PLold _ | PLat _
+ | PLoffset _ | PLbase_addr _ | PLblock_length _
+ | PLupdate _ | PLinitField _ | PLinitIndex _
+ | PLvalid _ | PLvalid_read _ | PLvalid_function _
+ | PLinitialized _ | PLdangling _
+ | PLallocable _ | PLfreeable _ | PLfresh _
+ | PLseparated _ | PLsubtype _ | PLunion _ | PLinter _ -> 10
+ | PLvar _ | PLconstant _ | PLresult | PLnull | PLtypeof _ | PLtype _
+ | PLfalse | PLtrue | PLcomprehension _ | PLempty | PLset _ | PLlist _ -> 0
let rec print_path_elt fmt = function
- | PLpathField s -> fprintf fmt ".%s" s
- | PLpathIndex i -> fprintf fmt "[@[%a@]]" print_lexpr i
+ | PLpathField s -> fprintf fmt ".%s" s
+ | PLpathIndex i -> fprintf fmt "[@[%a@]]" print_lexpr i
and print_path_val fmt (path, v) =
match v with
- | PLupdateTerm e ->
- fprintf fmt "@[%a@ =@ %a@]"
- (pp_list ~sep:"@;" print_path_elt) path print_lexpr e
- | PLupdateCont path_val_list ->
- fprintf fmt "{ \\with %a@ }"
- (pp_list ~sep:",@ " print_path_val) path_val_list
+ | PLupdateTerm e ->
+ fprintf fmt "@[%a@ =@ %a@]"
+ (pp_list ~sep:"@;" print_path_elt) path print_lexpr e
+ | PLupdateCont path_val_list ->
+ fprintf fmt "{ \\with %a@ }"
+ (pp_list ~sep:",@ " print_path_val) path_val_list
and print_init_index fmt (i,v) =
print_path_val fmt ([PLpathIndex i], PLupdateTerm v)
@@ -159,14 +159,14 @@ and print_init_field fmt (s,v) =
and print_lexpr fmt e = print_lexpr_level 100 fmt e
and print_label_1 fmt l =
- match l with
- | None -> ()
- | Some s -> fprintf fmt "{%s}" s
+ match l with
+ | None -> ()
+ | Some s -> fprintf fmt "{%s}" s
and print_label_2 fmt l =
- match l with
- | None -> ()
- | Some (s1,s2) -> fprintf fmt "{%s,%s}" s1 s2
+ match l with
+ | None -> ()
+ | Some (s1,s2) -> fprintf fmt "{%s,%s}" s1 s2
and print_lexpr_level n fmt e =
let n' = getParenthLevel e in
@@ -174,134 +174,134 @@ and print_lexpr_level n fmt e =
let print_lexpr_plain fmt e = print_lexpr_level 100 fmt e in
let aux fmt e =
match e.lexpr_node with
- PLvar s -> pp_print_string fmt s
- | PLapp(s,tv,args) ->
- fprintf fmt "%s@;%a@;(@[%a@])"
- s
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>" pp_print_string) tv
- (pp_list ~sep:",@ " print_lexpr_plain) args
- | PLlambda (quant,e) ->
- fprintf fmt "@[<2>\\lambda@ @[%a@];@ %a@]"
- print_quantifiers quant print_lexpr e
- | PLlet (n,def,body) ->
- fprintf fmt "@[@[<2>\\let@ %s@ =@ %a;@]@\n%a@]"
- n print_lexpr def print_lexpr body
- | PLconstant c -> print_constant fmt c
- | PLunop(op,e) -> fprintf fmt "%s%a" (get_unop_string op) print_lexpr e
- | PLbinop(e1,op,e2) ->
- fprintf fmt "%a@ %s@ %a"
- print_lexpr e1 (get_binop_string op) print_lexpr e2
- | PLdot(e,f) -> fprintf fmt "%a.%s" print_lexpr e f
- | PLarrow(e,f) -> fprintf fmt "%a->%s" print_lexpr e f
- | PLarrget(b,i) ->
- fprintf fmt "%a[@;@[%a@]@;]" print_lexpr b print_lexpr i
- | PLlist(args) ->
- fprintf fmt "[@[%a@]]"
- (pp_list ~sep:",@ " print_lexpr_plain) args
- | PLrepeat(e1,e2) ->
- fprintf fmt "%a@ *^@ %a"
- print_lexpr e1 print_lexpr e2
- | PLold(e) -> fprintf fmt "\\old(@;@[%a@]@;)" print_lexpr_plain e
- | PLat(e,s) -> fprintf fmt "\\at(@;@[%a,@ %s@]@;)" print_lexpr_plain e s
- | PLbase_addr (l,e) -> fprintf fmt "\\base_addr%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
- | PLblock_length (l,e) ->
- fprintf fmt "\\block_length%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
- | PLoffset (l,e) ->
- fprintf fmt "\\offset%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
- | PLresult -> pp_print_string fmt "\\result"
- | PLnull -> pp_print_string fmt "\\null"
- | PLcast (t,e) -> fprintf fmt "(@[%a@])@;%a"
- (print_logic_type None) t print_lexpr e
- | PLrange(e1,e2) ->
- fprintf fmt "%a@;..@;%a"
- (pp_opt print_lexpr) e1 (pp_opt print_lexpr) e2
- | PLsizeof t -> fprintf fmt "sizeof(@;@[%a@]@;)" (print_logic_type None) t
- | PLsizeofE e -> fprintf fmt "sizeof(@;@[%a@]@;)" print_lexpr_plain e
- | PLcoercion(e,t) ->
- fprintf fmt "%a@ :>@ %a" print_lexpr e (print_logic_type None) t
- | PLcoercionE(e1,e2) ->
- fprintf fmt "%a@ :>@ %a" print_lexpr e1 print_lexpr e2
- | PLupdate(e1,path,e2) ->
- fprintf fmt "{@ @[%a@ \\with@ %a@]}"
- print_lexpr_plain e1 print_path_val (path, e2)
- | PLinitField(init_field_list) ->
- fprintf fmt "{@ %a@}"
- (pp_list ~sep:",@ " print_init_field) init_field_list
- | PLinitIndex(init_index_list) ->
- fprintf fmt "{@ %a@}"
- (pp_list ~sep:",@ " print_init_index) init_index_list
- | PLtypeof e -> fprintf fmt "typeof(@;@[%a@]@;)" print_lexpr_plain e
- | PLtype t -> fprintf fmt "\\type(@;@[%a@]@;" (print_logic_type None) t
- | PLfalse -> pp_print_string fmt "\\false"
- | PLtrue -> pp_print_string fmt "\\true"
- | PLrel (e1,rel,e2) ->
- fprintf fmt "%a@ %s@ %a"
- print_lexpr e1 (get_relation_string rel) print_lexpr e2
- | PLand(e1,e2) -> fprintf fmt "%a@ &&@ %a" print_lexpr e1 print_lexpr e2
- | PLor(e1,e2) -> fprintf fmt "%a@ ||@ %a" print_lexpr e1 print_lexpr e2
- | PLxor(e1,e2) -> fprintf fmt "%a@ ^^@ %a" print_lexpr e1 print_lexpr e2
- | PLimplies(e1,e2) ->
- fprintf fmt "%a@ ==>@ %a" print_lexpr e1 print_lexpr e2
- | PLiff(e1,e2) ->
- fprintf fmt "%a@ <==>@ %a" print_lexpr e1 print_lexpr e2
- | PLnot e -> fprintf fmt "!@;%a" print_lexpr e
- | PLif (e1,e2,e3) ->
- fprintf fmt "%a@ ?@ %a@ :@ %a"
- print_lexpr e1 print_lexpr e2 print_lexpr e3
- | PLforall(q,e) ->
- fprintf fmt "@[\\forall@ @[%a@];@ %a@]"
- print_quantifiers q print_lexpr e
- | PLexists(q,e) ->
- fprintf fmt "@[\\exists@ @[%a@];@ %a@]"
- print_quantifiers q print_lexpr e
- | PLvalid (l,e) -> fprintf fmt "\\valid%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
- | PLvalid_read (l,e) -> fprintf fmt "\\valid_read%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
- | PLvalid_function e ->
- fprintf fmt "\\valid_function(@;@[%a@]@;)" print_lexpr_plain e
- | PLinitialized (l,e) ->
- fprintf fmt "\\initialized%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
- | PLdangling (l,e) ->
- fprintf fmt "\\dangling%a(@;@[%a@]@;)"
- print_label_1 l print_lexpr_plain e
- | PLseparated l ->
- fprintf fmt "\\separated(@;@[%a@]@;)"
- (pp_list ~sep:",@ " print_lexpr_plain) l
- | PLfreeable (l,e) ->
- fprintf fmt "\\freeable%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
- | PLallocable (l,e) ->
- fprintf fmt "\\allocable%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
- | PLfresh (l2,e1,e2) ->
- fprintf fmt "\\fresh%a(@;@[%a@],@[%a@]@;)" print_label_2 l2 print_lexpr_plain e1 print_lexpr_plain e2
- | PLnamed(s,e) -> fprintf fmt "%s:@ %a" s print_lexpr e
- | PLsubtype (e1,e2) ->
- fprintf fmt "%a@ <:@ %a" print_lexpr e1 print_lexpr e2
- | PLcomprehension(e,q,p) ->
- fprintf fmt "{@ @[%a;@ %a%a@]@ }"
- print_lexpr e print_quantifiers q
- (pp_opt ~pre:"@ |@ " print_lexpr) p
- | PLset l ->
- fprintf fmt "{@ @[%a@]@ }"
- (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
- | PLempty -> pp_print_string fmt "\\empty"
- | PLunion l->
- fprintf fmt "\\union(%a)"
- (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
- | PLinter l->
- fprintf fmt "\\inter(%a)"
- (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
+ PLvar s -> pp_print_string fmt s
+ | PLapp(s,tv,args) ->
+ fprintf fmt "%s@;%a@;(@[%a@])"
+ s
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@]>" pp_print_string) tv
+ (pp_list ~sep:",@ " print_lexpr_plain) args
+ | PLlambda (quant,e) ->
+ fprintf fmt "@[<2>\\lambda@ @[%a@];@ %a@]"
+ print_quantifiers quant print_lexpr e
+ | PLlet (n,def,body) ->
+ fprintf fmt "@[@[<2>\\let@ %s@ =@ %a;@]@\n%a@]"
+ n print_lexpr def print_lexpr body
+ | PLconstant c -> print_constant fmt c
+ | PLunop(op,e) -> fprintf fmt "%s%a" (get_unop_string op) print_lexpr e
+ | PLbinop(e1,op,e2) ->
+ fprintf fmt "%a@ %s@ %a"
+ print_lexpr e1 (get_binop_string op) print_lexpr e2
+ | PLdot(e,f) -> fprintf fmt "%a.%s" print_lexpr e f
+ | PLarrow(e,f) -> fprintf fmt "%a->%s" print_lexpr e f
+ | PLarrget(b,i) ->
+ fprintf fmt "%a[@;@[%a@]@;]" print_lexpr b print_lexpr i
+ | PLlist(args) ->
+ fprintf fmt "[@[%a@]]"
+ (pp_list ~sep:",@ " print_lexpr_plain) args
+ | PLrepeat(e1,e2) ->
+ fprintf fmt "%a@ *^@ %a"
+ print_lexpr e1 print_lexpr e2
+ | PLold(e) -> fprintf fmt "\\old(@;@[%a@]@;)" print_lexpr_plain e
+ | PLat(e,s) -> fprintf fmt "\\at(@;@[%a,@ %s@]@;)" print_lexpr_plain e s
+ | PLbase_addr (l,e) -> fprintf fmt "\\base_addr%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
+ | PLblock_length (l,e) ->
+ fprintf fmt "\\block_length%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
+ | PLoffset (l,e) ->
+ fprintf fmt "\\offset%a(@;@[%a@])" print_label_1 l print_lexpr_plain e
+ | PLresult -> pp_print_string fmt "\\result"
+ | PLnull -> pp_print_string fmt "\\null"
+ | PLcast (t,e) -> fprintf fmt "(@[%a@])@;%a"
+ (print_logic_type None) t print_lexpr e
+ | PLrange(e1,e2) ->
+ fprintf fmt "%a@;..@;%a"
+ (pp_opt print_lexpr) e1 (pp_opt print_lexpr) e2
+ | PLsizeof t -> fprintf fmt "sizeof(@;@[%a@]@;)" (print_logic_type None) t
+ | PLsizeofE e -> fprintf fmt "sizeof(@;@[%a@]@;)" print_lexpr_plain e
+ | PLcoercion(e,t) ->
+ fprintf fmt "%a@ :>@ %a" print_lexpr e (print_logic_type None) t
+ | PLcoercionE(e1,e2) ->
+ fprintf fmt "%a@ :>@ %a" print_lexpr e1 print_lexpr e2
+ | PLupdate(e1,path,e2) ->
+ fprintf fmt "{@ @[%a@ \\with@ %a@]}"
+ print_lexpr_plain e1 print_path_val (path, e2)
+ | PLinitField(init_field_list) ->
+ fprintf fmt "{@ %a@}"
+ (pp_list ~sep:",@ " print_init_field) init_field_list
+ | PLinitIndex(init_index_list) ->
+ fprintf fmt "{@ %a@}"
+ (pp_list ~sep:",@ " print_init_index) init_index_list
+ | PLtypeof e -> fprintf fmt "typeof(@;@[%a@]@;)" print_lexpr_plain e
+ | PLtype t -> fprintf fmt "\\type(@;@[%a@]@;" (print_logic_type None) t
+ | PLfalse -> pp_print_string fmt "\\false"
+ | PLtrue -> pp_print_string fmt "\\true"
+ | PLrel (e1,rel,e2) ->
+ fprintf fmt "%a@ %s@ %a"
+ print_lexpr e1 (get_relation_string rel) print_lexpr e2
+ | PLand(e1,e2) -> fprintf fmt "%a@ &&@ %a" print_lexpr e1 print_lexpr e2
+ | PLor(e1,e2) -> fprintf fmt "%a@ ||@ %a" print_lexpr e1 print_lexpr e2
+ | PLxor(e1,e2) -> fprintf fmt "%a@ ^^@ %a" print_lexpr e1 print_lexpr e2
+ | PLimplies(e1,e2) ->
+ fprintf fmt "%a@ ==>@ %a" print_lexpr e1 print_lexpr e2
+ | PLiff(e1,e2) ->
+ fprintf fmt "%a@ <==>@ %a" print_lexpr e1 print_lexpr e2
+ | PLnot e -> fprintf fmt "!@;%a" print_lexpr e
+ | PLif (e1,e2,e3) ->
+ fprintf fmt "%a@ ?@ %a@ :@ %a"
+ print_lexpr e1 print_lexpr e2 print_lexpr e3
+ | PLforall(q,e) ->
+ fprintf fmt "@[\\forall@ @[%a@];@ %a@]"
+ print_quantifiers q print_lexpr e
+ | PLexists(q,e) ->
+ fprintf fmt "@[\\exists@ @[%a@];@ %a@]"
+ print_quantifiers q print_lexpr e
+ | PLvalid (l,e) -> fprintf fmt "\\valid%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
+ | PLvalid_read (l,e) -> fprintf fmt "\\valid_read%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
+ | PLvalid_function e ->
+ fprintf fmt "\\valid_function(@;@[%a@]@;)" print_lexpr_plain e
+ | PLinitialized (l,e) ->
+ fprintf fmt "\\initialized%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
+ | PLdangling (l,e) ->
+ fprintf fmt "\\dangling%a(@;@[%a@]@;)"
+ print_label_1 l print_lexpr_plain e
+ | PLseparated l ->
+ fprintf fmt "\\separated(@;@[%a@]@;)"
+ (pp_list ~sep:",@ " print_lexpr_plain) l
+ | PLfreeable (l,e) ->
+ fprintf fmt "\\freeable%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
+ | PLallocable (l,e) ->
+ fprintf fmt "\\allocable%a(@;@[%a@]@;)" print_label_1 l print_lexpr_plain e
+ | PLfresh (l2,e1,e2) ->
+ fprintf fmt "\\fresh%a(@;@[%a@],@[%a@]@;)" print_label_2 l2 print_lexpr_plain e1 print_lexpr_plain e2
+ | PLnamed(s,e) -> fprintf fmt "%s:@ %a" s print_lexpr e
+ | PLsubtype (e1,e2) ->
+ fprintf fmt "%a@ <:@ %a" print_lexpr e1 print_lexpr e2
+ | PLcomprehension(e,q,p) ->
+ fprintf fmt "{@ @[%a;@ %a%a@]@ }"
+ print_lexpr e print_quantifiers q
+ (pp_opt ~pre:"@ |@ " print_lexpr) p
+ | PLset l ->
+ fprintf fmt "{@ @[%a@]@ }"
+ (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
+ | PLempty -> pp_print_string fmt "\\empty"
+ | PLunion l->
+ fprintf fmt "\\union(%a)"
+ (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
+ | PLinter l->
+ fprintf fmt "\\inter(%a)"
+ (pp_list ~pre:"@;@[" ~sep:",@ " ~suf:"@]@;" print_lexpr_plain) l
in
if n <= n' then fprintf fmt "(@[%a@])" aux e else aux fmt e
let print_typedef fmt = function
- | TDsum l ->
- let print_const fmt (s,args) =
- fprintf fmt "%s%a" s
- (pp_list ~pre:"@ (@[" ~sep:",@ " ~suf:"@])"
- (print_logic_type None))
- args
- in
- pp_list ~sep:"@ |@ " print_const fmt l
- | TDsyn t -> print_logic_type None fmt t
+ | TDsum l ->
+ let print_const fmt (s,args) =
+ fprintf fmt "%s%a" s
+ (pp_list ~pre:"@ (@[" ~sep:",@ " ~suf:"@])"
+ (print_logic_type None))
+ args
+ in
+ pp_list ~sep:"@ |@ " print_const fmt l
+ | TDsyn t -> print_logic_type None fmt t
let print_type_annot fmt ty =
fprintf fmt "@[type@ invariant@ %s(@;@[%a@ %s]@;)@ =@ %a;@]"
@@ -310,109 +310,109 @@ let print_type_annot fmt ty =
let print_model_annot fmt ty =
fprintf fmt "@[model@ %a {@;@[%a@ %s]@;}@ @]"
- (print_logic_type None) ty.model_for_type
- (print_logic_type None) ty.model_type
+ (print_logic_type None) ty.model_for_type
+ (print_logic_type None) ty.model_type
ty.model_name
let rec print_decl fmt d =
match d.decl_node with
- | LDlogic_def(name,labels,tvar,rt,prms,body) ->
- fprintf fmt "@[<2>logic@ %a@ %s%a%a%a@ =@ %a;@]"
- (print_logic_type None) rt name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
- print_lexpr body
- | LDlogic_reads(name,labels,tvar,rt,prms,reads) ->
- fprintf fmt "@[<2>logic@ %a@ %s%a%a%a@ =@ %a;@]"
- (print_logic_type None) rt name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
- (pp_opt ~pre:"@[<2>reads@ " (pp_list ~sep:",@ " print_lexpr)) reads
- | LDtype(name,tvar,def) ->
- fprintf fmt "@[<2>type@ %s%a%a;@]" name
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_opt ~pre:"@ =@ " print_typedef) def
- | LDpredicate_reads(name,labels,tvar,prms,reads) ->
- fprintf fmt "@[<2>predicate@ %s%a%a%a@ =@ %a;@]" name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
- (pp_opt ~pre:"@[<2>reads@ " (pp_list ~sep:",@ " print_lexpr)) reads
- | LDpredicate_def(name,labels,tvar,prms,body) ->
- fprintf fmt "@[<2>predicate@ %s%a%a%a@ =@ %a;@]" name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
- print_lexpr body
- | LDinductive_def(name,labels,tvar,prms,cases) ->
- let print_case fmt (name,labels,tvar,body) =
- fprintf fmt "@[<2>case@ %s%a%a:@ %a;@]" name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- print_lexpr body
- in
- fprintf fmt "@[<2>inductive@ %s%a%a@;(%a)@ {@\n%a@]@\n}" name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- (pp_list ~sep:",@ " print_typed_ident) prms
- (pp_list ~sep:"@\n" print_case) cases
- | LDlemma(name,is_axiom,labels,tvar,body) ->
- fprintf fmt "@[<2>%a@ %s%a%a:@ %a;@]"
- (pp_cond ~pr_false:"lemma" is_axiom) "axiom" name
- (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
- (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
- print_lexpr body
- | LDaxiomatic (s,d) ->
- fprintf fmt "@[<2>axiomatic@ %s@ {@\n%a@]@\n}" s
- (pp_list ~sep:"@\n" print_decl) d
- | LDinvariant (s,e) ->
- fprintf fmt "@[<2>invariant@ %s:@ %a;@]" s print_lexpr e
- | LDtype_annot ty -> print_type_annot fmt ty
- | LDmodel_annot ty -> print_model_annot fmt ty
- | LDvolatile(tsets,(read,write)) ->
- fprintf fmt "@[<2>volatile@ %a%a%a;@]"
- (pp_list ~pre:"@[" ~sep:",@ " ~suf:"@]" print_lexpr) tsets
- (pp_opt ~pre:"@ reads@ " pp_print_string) read
- (pp_opt ~pre:"@ writes@ " pp_print_string) write
- | LDextended (s,l) ->
- fprintf fmt "@[<2>%s@ %a@]" s (pp_list ~sep:",@ " print_lexpr) l
+ | LDlogic_def(name,labels,tvar,rt,prms,body) ->
+ fprintf fmt "@[<2>logic@ %a@ %s%a%a%a@ =@ %a;@]"
+ (print_logic_type None) rt name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
+ print_lexpr body
+ | LDlogic_reads(name,labels,tvar,rt,prms,reads) ->
+ fprintf fmt "@[<2>logic@ %a@ %s%a%a%a@ =@ %a;@]"
+ (print_logic_type None) rt name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
+ (pp_opt ~pre:"@[<2>reads@ " (pp_list ~sep:",@ " print_lexpr)) reads
+ | LDtype(name,tvar,def) ->
+ fprintf fmt "@[<2>type@ %s%a%a;@]" name
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_opt ~pre:"@ =@ " print_typedef) def
+ | LDpredicate_reads(name,labels,tvar,prms,reads) ->
+ fprintf fmt "@[<2>predicate@ %s%a%a%a@ =@ %a;@]" name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
+ (pp_opt ~pre:"@[<2>reads@ " (pp_list ~sep:",@ " print_lexpr)) reads
+ | LDpredicate_def(name,labels,tvar,prms,body) ->
+ fprintf fmt "@[<2>predicate@ %s%a%a%a@ =@ %a;@]" name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_list ~pre:"(@[" ~sep:",@ " ~suf:"@])" print_typed_ident) prms
+ print_lexpr body
+ | LDinductive_def(name,labels,tvar,prms,cases) ->
+ let print_case fmt (name,labels,tvar,body) =
+ fprintf fmt "@[<2>case@ %s%a%a:@ %a;@]" name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ print_lexpr body
+ in
+ fprintf fmt "@[<2>inductive@ %s%a%a@;(%a)@ {@\n%a@]@\n}" name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ (pp_list ~sep:",@ " print_typed_ident) prms
+ (pp_list ~sep:"@\n" print_case) cases
+ | LDlemma(name,is_axiom,labels,tvar,body) ->
+ fprintf fmt "@[<2>%a@ %s%a%a:@ %a;@]"
+ (pp_cond ~pr_false:"lemma" is_axiom) "axiom" name
+ (pp_list ~pre:"{@[" ~sep:",@ " ~suf:"@]}" pp_print_string) labels
+ (pp_list ~pre:"<@[" ~sep:",@ " ~suf:"@>}" pp_print_string) tvar
+ print_lexpr body
+ | LDaxiomatic (s,d) ->
+ fprintf fmt "@[<2>axiomatic@ %s@ {@\n%a@]@\n}" s
+ (pp_list ~sep:"@\n" print_decl) d
+ | LDinvariant (s,e) ->
+ fprintf fmt "@[<2>invariant@ %s:@ %a;@]" s print_lexpr e
+ | LDtype_annot ty -> print_type_annot fmt ty
+ | LDmodel_annot ty -> print_model_annot fmt ty
+ | LDvolatile(tsets,(read,write)) ->
+ fprintf fmt "@[<2>volatile@ %a%a%a;@]"
+ (pp_list ~pre:"@[" ~sep:",@ " ~suf:"@]" print_lexpr) tsets
+ (pp_opt ~pre:"@ reads@ " pp_print_string) read
+ (pp_opt ~pre:"@ writes@ " pp_print_string) write
+ | LDextended (s,l) ->
+ fprintf fmt "@[<2>%s@ %a@]" s (pp_list ~sep:",@ " print_lexpr) l
let print_deps fmt deps =
match deps with
- FromAny -> ()
- | From l ->
- pp_list ~pre:"@ @[<2>\\from@ " ~sep:",@ " ~suf:"@]" print_lexpr fmt l
+ FromAny -> ()
+ | From l ->
+ pp_list ~pre:"@ @[<2>\\from@ " ~sep:",@ " ~suf:"@]" print_lexpr fmt l
let print_assigns fmt a =
match a with
- WritesAny -> ()
- | Writes l ->
- pp_list ~pre:"" ~sep:"" ~suf:""
- (fun fmt (loc,deps) ->
- fprintf fmt "@\nassigns@ %a%a;"
- print_lexpr loc
- print_deps deps)
- fmt l
-
-let print_allocation ~isloop fmt fa =
+ WritesAny -> ()
+ | Writes l ->
+ pp_list ~pre:"" ~sep:"" ~suf:""
+ (fun fmt (loc,deps) ->
+ fprintf fmt "@\nassigns@ %a%a;"
+ print_lexpr loc
+ print_deps deps)
+ fmt l
+
+let print_allocation ~isloop fmt fa =
match fa with
- | FreeAllocAny -> ()
- | FreeAlloc([],[]) ->
- let prefix = if isloop then "loop " else "" in
- fprintf fmt "@\n%sallocates@ \\nothing;" prefix
- | FreeAlloc(f,a) ->
- let prefix = if isloop then "loop " else "" in
- let pFreeAlloc kw fmt af =
- match af with
- | [] -> ()
- | _ -> fprintf fmt "@\n%s%s@ %a;" prefix kw (pp_list ~sep:",@ " print_lexpr) a
- in fprintf fmt "%a%a" (pFreeAlloc "frees") f (pFreeAlloc "allocates") a
+ | FreeAllocAny -> ()
+ | FreeAlloc([],[]) ->
+ let prefix = if isloop then "loop " else "" in
+ fprintf fmt "@\n%sallocates@ \\nothing;" prefix
+ | FreeAlloc(f,a) ->
+ let prefix = if isloop then "loop " else "" in
+ let pFreeAlloc kw fmt af =
+ match af with
+ | [] -> ()
+ | _ -> fprintf fmt "@\n%s%s@ %a;" prefix kw (pp_list ~sep:",@ " print_lexpr) a
+ in fprintf fmt "%a%a" (pFreeAlloc "frees") f (pFreeAlloc "allocates") a
let print_clause name fmt e = fprintf fmt "@\n%s@ %a;" name print_lexpr e
-let print_post fmt (k,e) =
+let print_post fmt (k,e) =
print_clause (Cil_printer.get_termination_kind_name k) fmt e
let print_behavior fmt bhv =
@@ -423,7 +423,7 @@ let print_behavior fmt bhv =
(pp_list ~pre:"" ~suf:"" print_post) bhv.b_post_cond
(print_allocation ~isloop:false) bhv.b_allocation
print_assigns bhv.b_assigns
- (* TODO: prints extensions *)
+(* TODO: prints extensions *)
let print_variant fmt (v,cmp) =
fprintf fmt "%a%a;" print_lexpr v
@@ -443,28 +443,28 @@ let print_spec fmt spec =
let print_loop_pragma fmt p =
match p with
- Unroll_specs l -> fprintf fmt "UNROLL@ %a" (pp_list ~sep:",@ " print_lexpr) l
- | Widen_hints l ->
- fprintf fmt "WIDEN_HINTS@ %a" (pp_list ~sep:",@ " print_lexpr) l
- | Widen_variables l ->
- fprintf fmt "WIDEN_VARIABLES@ %a" (pp_list ~sep:",@ " print_lexpr) l
+ Unroll_specs l -> fprintf fmt "UNROLL@ %a" (pp_list ~sep:",@ " print_lexpr) l
+ | Widen_hints l ->
+ fprintf fmt "WIDEN_HINTS@ %a" (pp_list ~sep:",@ " print_lexpr) l
+ | Widen_variables l ->
+ fprintf fmt "WIDEN_VARIABLES@ %a" (pp_list ~sep:",@ " print_lexpr) l
let print_slice_pragma fmt p =
match p with
- | SPexpr e -> fprintf fmt "expr@ %a" print_lexpr e
- | SPctrl -> pp_print_string fmt "ctrl"
- | SPstmt -> pp_print_string fmt "stmt"
+ | SPexpr e -> fprintf fmt "expr@ %a" print_lexpr e
+ | SPctrl -> pp_print_string fmt "ctrl"
+ | SPstmt -> pp_print_string fmt "stmt"
let print_impact_pragma fmt p =
match p with
- | IPexpr e -> fprintf fmt "expr@ %a" print_lexpr e
- | IPstmt -> pp_print_string fmt "stmt"
+ | IPexpr e -> fprintf fmt "expr@ %a" print_lexpr e
+ | IPstmt -> pp_print_string fmt "stmt"
let print_pragma fmt p =
match p with
- Loop_pragma p -> fprintf fmt "loop@ pragma@ %a;" print_loop_pragma p
- | Slice_pragma p -> fprintf fmt "slice@ pragma@ %a;" print_slice_pragma p
- | Impact_pragma p -> fprintf fmt "impact@ pragma@ %a;" print_impact_pragma p
+ Loop_pragma p -> fprintf fmt "loop@ pragma@ %a;" print_loop_pragma p
+ | Slice_pragma p -> fprintf fmt "slice@ pragma@ %a;" print_slice_pragma p
+ | Impact_pragma p -> fprintf fmt "impact@ pragma@ %a;" print_impact_pragma p
let print_extension fmt (name, ext) =
fprintf fmt "%s %a" name (pp_list ~sep:",@ " print_lexpr) ext
@@ -474,26 +474,26 @@ let print_code_annot fmt ca =
(pp_list ~pre:"for@ " ~sep:",@ " ~suf:":@ " pp_print_string) fmt bhvs
in
match ca with
- AAssert(bhvs,e) ->
- fprintf fmt "%aassert@ %a;" print_behaviors bhvs print_lexpr e
- | AStmtSpec (bhvs,s) ->
- fprintf fmt "%a%a"
- print_behaviors bhvs
- print_spec s
- | AInvariant (bhvs,loop,e) ->
- fprintf fmt "%a%ainvariant@ %a;"
- print_behaviors bhvs (pp_cond loop) "loop@ " print_lexpr e
- | AVariant e -> fprintf fmt "loop@ variant@ %a;" print_variant e
- | AAssigns (bhvs,a) ->
- fprintf fmt "%aloop@ %a" print_behaviors bhvs print_assigns a
- | AAllocation (bhvs,fa) ->
- fprintf fmt "%a%a" print_behaviors bhvs (print_allocation ~isloop:true) fa
- | APragma p -> print_pragma fmt p
- | AExtended (bhvs, is_loop, e) ->
- fprintf fmt "%a%s%a"
- print_behaviors bhvs
- (if is_loop then " loop " else "")
- print_extension e
+ AAssert(bhvs,e) ->
+ fprintf fmt "%aassert@ %a;" print_behaviors bhvs print_lexpr e
+ | AStmtSpec (bhvs,s) ->
+ fprintf fmt "%a%a"
+ print_behaviors bhvs
+ print_spec s
+ | AInvariant (bhvs,loop,e) ->
+ fprintf fmt "%a%ainvariant@ %a;"
+ print_behaviors bhvs (pp_cond loop) "loop@ " print_lexpr e
+ | AVariant e -> fprintf fmt "loop@ variant@ %a;" print_variant e
+ | AAssigns (bhvs,a) ->
+ fprintf fmt "%aloop@ %a" print_behaviors bhvs print_assigns a
+ | AAllocation (bhvs,fa) ->
+ fprintf fmt "%a%a" print_behaviors bhvs (print_allocation ~isloop:true) fa
+ | APragma p -> print_pragma fmt p
+ | AExtended (bhvs, is_loop, e) ->
+ fprintf fmt "%a%s%a"
+ print_behaviors bhvs
+ (if is_loop then " loop " else "")
+ print_extension e
(*
Local Variables:
compile-command: "make -C ../../.."
diff --git a/src/kernel_services/ast_printing/printer.ml b/src/kernel_services/ast_printing/printer.ml
index 27c8a438e075f0d31e60e9db083b7402677e1c88..a0b5481860176df7d553f645376fc68a12598c73 100644
--- a/src/kernel_services/ast_printing/printer.ml
+++ b/src/kernel_services/ast_printing/printer.ml
@@ -101,18 +101,18 @@ class printer_with_annot () = object (self)
print_spec <- false
method private current_kf = match self#current_function with
- | None -> assert false
- | Some vi -> Globals.Functions.get vi
+ | None -> assert false
+ | Some vi -> Globals.Functions.get vi
method private current_kinstr = match self#current_stmt with
- | None -> Kglobal
- | Some st -> Kstmt st
+ | None -> Kglobal
+ | Some st -> Kstmt st
method private current_sid = match self#current_stmt with
- | None -> assert false
- | Some st -> st.sid
+ | None -> assert false
+ | Some st -> st.sid
- method! private may_be_skipped s =
+ method! private may_be_skipped s =
super#may_be_skipped s && not (Annotations.has_code_annot s)
method private pretty_funspec fmt kf =
@@ -126,14 +126,14 @@ class printer_with_annot () = object (self)
method! private inline_block ctxt blk =
super#inline_block ctxt blk
- && (match blk.bstmts with
- | [] -> true
- | [ s ] ->
- not (Annotations.has_code_annot s && logic_printer_enabled)
- && (match s.skind with
- | Block blk -> self#inline_block ctxt blk
- | _ -> true)
- | _ :: _ -> false)
+ && (match blk.bstmts with
+ | [] -> true
+ | [ s ] ->
+ not (Annotations.has_code_annot s && logic_printer_enabled)
+ && (match s.skind with
+ | Block blk -> self#inline_block ctxt blk
+ | _ -> true)
+ | _ :: _ -> false)
method! varinfo fmt v =
if Kernel.is_debug_key_enabled Kernel.dkey_print_vid then begin
@@ -165,9 +165,9 @@ class printer_with_annot () = object (self)
declared_globs <- Cil_datatype.Varinfo.Set.add vi declared_globs;
(* pretty prints the spec, but not for built-ins*)
if not (Cil.Builtin_functions.mem vi.vname) then
- self#pretty_funspec fmt kf
+ self#pretty_funspec fmt kf
end
- with Not_found ->
+ with Not_found ->
());
print_spec <- false;
super#vdecl fmt vi;
@@ -176,8 +176,8 @@ class printer_with_annot () = object (self)
method! global fmt glob =
if Kernel.PrintComments.get () && Cil_printer.print_global glob then begin
let comments = Globals.get_comments_global glob in
- Pretty_utils.pp_list
- ~sep:"@\n" ~suf:"@\n"
+ Pretty_utils.pp_list
+ ~sep:"@\n" ~suf:"@\n"
(fun fmt s -> Format.fprintf fmt "/* %s */" s) fmt comments
end;
(* Out of tree global annotations are pretty printed before the first
@@ -216,15 +216,15 @@ class printer_with_annot () = object (self)
(* To debug location setting:
(let loc = fst (Cil_datatype.Stmt.loc s.skind) in
Format.fprintf fmt "/*Loc=%s:%d*/" loc.Lexing.pos_fname
- loc.Lexing.pos_lnum); *)
+ loc.Lexing.pos_lnum); *)
Format.pp_open_hvbox fmt 0;
(* print the labels *)
self#stmt_labels fmt s;
if Kernel.PrintComments.get () then begin
let comments = Globals.get_comments_stmt s in
if comments <> [] then
- Pretty_utils.pp_list ~sep:"@\n" ~suf:"@]@\n"
- (fun fmt s -> Format.fprintf fmt "@[/* %s */@]" s)
+ Pretty_utils.pp_list ~sep:"@\n" ~suf:"@]@\n"
+ (fun fmt s -> Format.fprintf fmt "@[/* %s */@]" s)
fmt comments
end;
if verbose || Kernel.is_debug_key_enabled Kernel.dkey_print_sid then
@@ -232,43 +232,43 @@ class printer_with_annot () = object (self)
(* print the annotations *)
if logic_printer_enabled then begin
let all_annot =
- List.sort
- Cil_datatype.Code_annotation.compare
- (Annotations.code_annot s)
+ List.sort
+ Cil_datatype.Code_annotation.compare
+ (Annotations.code_annot s)
in
let pGhost fmt s =
- let was_ghost = is_ghost in
- if not was_ghost && s.ghost then begin
+ let was_ghost = is_ghost in
+ if not was_ghost && s.ghost then begin
Format.fprintf fmt "%t %a "
(fun fmt -> self#pp_open_annotation ~pre:"@[/*@@" fmt)
self#pp_acsl_keyword "ghost";
is_ghost <- true
- end;
- self#stmtkind s.sattr next fmt s.skind;
- if not was_ghost && s.ghost then begin
+ end;
+ self#stmtkind s.sattr next fmt s.skind;
+ if not was_ghost && s.ghost then begin
self#pp_close_annotation ~suf:"@,*/@]" fmt;
is_ghost <- false;
- end
+ end
in
(match all_annot with
- | [] -> pGhost fmt s
- | [ a ] when Cil.is_skip s.skind && not s.ghost ->
- Format.fprintf fmt "@[<hv>@[%t@ %a@;<1 1>%t@]@ %a@]"
- (fun fmt -> self#pp_open_annotation ~block:false fmt)
- self#code_annotation a
- (fun fmt -> self#pp_close_annotation ~block:false fmt)
- (self#stmtkind s.sattr next) s.skind;
- | _ ->
- let loop_annot, stmt_annot =
- List.partition Logic_utils.is_loop_annot all_annot
- in
- self#annotations fmt stmt_annot;
- self#loop_annotations fmt loop_annot;
- pGhost fmt s)
+ | [] -> pGhost fmt s
+ | [ a ] when Cil.is_skip s.skind && not s.ghost ->
+ Format.fprintf fmt "@[<hv>@[%t@ %a@;<1 1>%t@]@ %a@]"
+ (fun fmt -> self#pp_open_annotation ~block:false fmt)
+ self#code_annotation a
+ (fun fmt -> self#pp_close_annotation ~block:false fmt)
+ (self#stmtkind s.sattr next) s.skind;
+ | _ ->
+ let loop_annot, stmt_annot =
+ List.partition Logic_utils.is_loop_annot all_annot
+ in
+ self#annotations fmt stmt_annot;
+ self#loop_annotations fmt loop_annot;
+ pGhost fmt s)
end else
self#stmtkind s.sattr next fmt s.skind;
Format.pp_close_box fmt ()
-
+
method! stmtkind sattr (next: stmt) fmt skind =
super#stmtkind sattr next fmt
begin
@@ -277,7 +277,7 @@ class printer_with_annot () = object (self)
when Kernel.PrintReturn.get () -> return
| _ -> skind
end
-
+
end (* class printer_with_annot *)
include Printer_builder.Make(struct class printer = printer_with_annot end)
@@ -302,11 +302,11 @@ let () = Cil_datatype.Term_lval.pretty_ref := pp_term_lval
let () = Cil_datatype.Term_offset.pretty_ref := pp_term_offset
let () = Cil_datatype.Code_annotation.pretty_ref := pp_code_annotation
let () = Cil_datatype.Funspec.pretty_ref := pp_funspec
-
+
let () = Cil_datatype.Label.pretty_ref := pp_label
let () = Cil_datatype.Compinfo.pretty_ref := pp_compinfo
let () = Cil_datatype.Fieldinfo.pretty_ref := (fun fmt f -> pp_varname fmt f.fname)
-let () = Cil_datatype.Builtin_logic_info.pretty_ref := pp_builtin_logic_info
+let () = Cil_datatype.Builtin_logic_info.pretty_ref := pp_builtin_logic_info
let () = Cil_datatype.Logic_type_info.pretty_ref := pp_logic_type_info
let () = Cil_datatype.Logic_ctor_info.pretty_ref := pp_logic_ctor_info
let () = Cil_datatype.Initinfo.pretty_ref := pp_initinfo
@@ -320,8 +320,8 @@ let () = Cil_datatype.Global.pretty_ref := pp_global
let () = Cil_datatype.Predicate.pretty_ref := pp_predicate
let () = Cil_datatype.Identified_predicate.pretty_ref := pp_identified_predicate
let () = Cil_datatype.Fundec.pretty_ref := pp_fundec
-
-
+
+
(*
Local Variables:
diff --git a/src/kernel_services/ast_printing/printer_api.mli b/src/kernel_services/ast_printing/printer_api.mli
index ad1b05fafc42fe074cd0743c7edb7d5705f619bf..78de7bf360627e7a59de0c7a2c9d6143ee61b95c 100644
--- a/src/kernel_services/ast_printing/printer_api.mli
+++ b/src/kernel_services/ast_printing/printer_api.mli
@@ -67,7 +67,7 @@ class type extensible_printer_type = object
method private current_function: varinfo option
(** @return the [varinfo] corresponding to the function being printed *)
-
+
method private current_behavior: funbehavior option
(** @return the [funbehavior] being pretty-printed. *)
@@ -107,7 +107,7 @@ class type extensible_printer_type = object
print sequences of instructions separated by comma *)
method private set_instr_terminator: string -> unit
-
+
method private opt_funspec: Format.formatter -> funspec -> unit
(* ******************************************************************* *)
@@ -149,9 +149,9 @@ class type extensible_printer_type = object
method ikind: Format.formatter -> ikind -> unit
method fkind: Format.formatter -> fkind -> unit
- method typ:
+ method typ:
?fundecl:varinfo ->
- (Format.formatter -> unit) option -> Format.formatter -> typ -> unit
+ (Format.formatter -> unit) option -> Format.formatter -> typ -> unit
(** Use of some type in some declaration. [fundecl] is the name of the
function which is declared with the corresponding type. The second
argument is used to print the declared element, or is None if we are just
@@ -164,7 +164,7 @@ class type extensible_printer_type = object
method attribute: Format.formatter -> attribute -> bool
(** Attribute. Also return an indication whether this attribute must be
printed inside the __attribute__ list or not. *)
-
+
method attributes: Format.formatter -> attributes -> unit
(** Attribute lists *)
@@ -172,9 +172,9 @@ class type extensible_printer_type = object
method compinfo: Format.formatter -> compinfo -> unit
method initinfo: Format.formatter -> initinfo -> unit
method fundec: Format.formatter -> fundec -> unit
-
- method line_directive:
+
+ method line_directive:
?forcefile:bool -> Format.formatter -> location -> unit
(** Print a line-number. This is assumed to come always on an empty line. If
the forcefile argument is present and is true then the file name will be
@@ -228,8 +228,8 @@ class type extensible_printer_type = object
method logic_constant: Format.formatter -> logic_constant -> unit
method logic_type:
- (Format.formatter -> unit) option -> Format.formatter -> logic_type
- -> unit
+ (Format.formatter -> unit) option -> Format.formatter -> logic_type
+ -> unit
method logic_type_def: Format.formatter -> logic_type_def -> unit
method model_info: Format.formatter -> model_info -> unit
method term_binop: Format.formatter -> binop -> unit
@@ -251,7 +251,7 @@ class type extensible_printer_type = object
method quantifiers: Format.formatter -> quantifiers -> unit
method predicate_node: Format.formatter -> predicate_node -> unit
method predicate: Format.formatter -> predicate -> unit
- method identified_predicate:
+ method identified_predicate:
Format.formatter -> identified_predicate -> unit
method behavior: Format.formatter -> funbehavior -> unit
method requires: Format.formatter -> identified_predicate -> unit
@@ -259,7 +259,7 @@ class type extensible_printer_type = object
method disjoint_behaviors: Format.formatter -> string list -> unit
method terminates: Format.formatter -> identified_predicate -> unit
- method post_cond:
+ method post_cond:
Format.formatter -> (termination_kind * identified_predicate) -> unit
(** pretty prints a post condition according to the exit kind it represents
@modify Boron-20100401 replaces [pEnsures] *)
@@ -309,8 +309,8 @@ class type extensible_printer_type = object
method without_annot:
'a.
(Format.formatter -> 'a -> unit) ->
- Format.formatter ->
- 'a ->
+ Format.formatter ->
+ 'a ->
unit
(** [self#without_annot printer fmt x] pretty prints [x] by using [printer],
without pretty-printing its function contracts and code annotations. *)
@@ -318,11 +318,11 @@ class type extensible_printer_type = object
method force_brace:
'a.
(Format.formatter -> 'a -> unit) ->
- Format.formatter ->
- 'a ->
+ Format.formatter ->
+ 'a ->
unit
-(** [self#force_brace printer fmt x] pretty prints [x] by using [printer],
- but add some extra braces '\{' and '\}' which are hidden by default. *)
+ (** [self#force_brace printer fmt x] pretty prints [x] by using [printer],
+ but add some extra braces '\{' and '\}' which are hidden by default. *)
end
@@ -342,31 +342,31 @@ type line_directive_style =
| Line_preprocessor_output (** Use # nnn directives (in gcc mode) *)
type state =
- { (** How to print line directives *)
- mutable line_directive_style: line_directive_style option;
- (** Whether we print something that will only be used as input to Cil's
- parser. In that case we are a bit more liberal in what we print. *)
- mutable print_cil_input: bool;
- (** Whether to print the CIL as they are, without trying to be smart and
- print nicer code. Normally this is false, in which case the pretty
- printer will turn the while(1) loops of CIL into nicer loops, will not
- print empty "else" blocks, etc. These is one case however in which if
- you turn this on you will get code that does not compile: if you use
- varargs the __builtin_va_arg function will be printed in its internal
- form. *)
- mutable print_cil_as_is: bool;
- (** The length used when wrapping output lines. Setting this variable to
- a large integer will prevent wrapping and make #line directives more
- accurate. *)
- mutable line_length: int;
- (** Emit warnings when truncating integer constants (default true) *)
- mutable warn_truncate: bool }
+ { (** How to print line directives *)
+ mutable line_directive_style: line_directive_style option;
+ (** Whether we print something that will only be used as input to Cil's
+ parser. In that case we are a bit more liberal in what we print. *)
+ mutable print_cil_input: bool;
+ (** Whether to print the CIL as they are, without trying to be smart and
+ print nicer code. Normally this is false, in which case the pretty
+ printer will turn the while(1) loops of CIL into nicer loops, will not
+ print empty "else" blocks, etc. These is one case however in which if
+ you turn this on you will get code that does not compile: if you use
+ varargs the __builtin_va_arg function will be printed in its internal
+ form. *)
+ mutable print_cil_as_is: bool;
+ (** The length used when wrapping output lines. Setting this variable to
+ a large integer will prevent wrapping and make #line directives more
+ accurate. *)
+ mutable line_length: int;
+ (** Emit warnings when truncating integer constants (default true) *)
+ mutable warn_truncate: bool }
(* ********************************************************************* *)
(** {2 Functions for pretty printing} *)
(* ********************************************************************* *)
-module type S = sig
+module type S_pp = sig
val pp_varname: Format.formatter -> string -> unit
@@ -417,7 +417,7 @@ module type S = sig
(** @since Oxygen-20120901 *)
val pp_term_lval: Format.formatter -> term_lval -> unit
- val pp_term_lhost: Format.formatter -> term_lhost -> unit
+ val pp_term_lhost: Format.formatter -> term_lhost -> unit
val pp_logic_var: Format.formatter -> logic_var -> unit
val pp_logic_type: Format.formatter -> logic_type -> unit
val pp_identified_term: Format.formatter -> identified_term -> unit
@@ -449,7 +449,7 @@ module type S = sig
val pp_loop_allocation: Format.formatter -> allocation -> unit
(** @since Oxygen-20120901 *)
- val pp_post_cond:
+ val pp_post_cond:
Format.formatter -> (termination_kind * identified_predicate) -> unit
(* ********************************************************************* *)
@@ -463,19 +463,25 @@ module type S = sig
val without_annot:
(Format.formatter -> 'a -> unit) ->
- Format.formatter ->
- 'a ->
+ Format.formatter ->
+ 'a ->
unit
(** [without_annot printer fmt x] pretty prints [x] by using [printer],
without pretty-printing its function contracts and code annotations. *)
val force_brace:
(Format.formatter -> 'a -> unit) ->
- Format.formatter ->
- 'a ->
+ Format.formatter ->
+ 'a ->
unit
- (** [self#force_brace printer fmt x] pretty prints [x] by using [printer],
- but add some extra braces '\{' and '\}' which are hidden by default. *)
+ (** [self#force_brace printer fmt x] pretty prints [x] by using [printer],
+ but add some extra braces '\{' and '\}' which are hidden by default. *)
+
+end
+
+module type S = sig
+
+ include S_pp
(* ********************************************************************* *)
(** {3 Extensible printer} *)
@@ -501,17 +507,17 @@ module type S = sig
This is how this function should be used:
-{[
-module PrinterClassDeferred (X: Printer.PrinterClass) = struct
- class printer : Printer.extensible_printer = object(self)
- inherit X.printer as super
- (* Override the standard methods *)
- end
-end
-let () = Printer.update_printer
- (module PrinterClassDeferred: Printer.PrinterExtension)
-]}
-*)
+ {[
+ module PrinterClassDeferred (X: Printer.PrinterClass) = struct
+ class printer : Printer.extensible_printer = object(self)
+ inherit X.printer as super
+ (* Override the standard methods *)
+ end
+ end
+ let () = Printer.update_printer
+ (module PrinterClassDeferred: Printer.PrinterExtension)
+ ]}
+ *)
val current_printer: unit -> (module PrinterClass)
(** Returns the current pretty-printer, with all the extensions added
diff --git a/src/kernel_services/ast_printing/printer_builder.ml b/src/kernel_services/ast_printing/printer_builder.ml
index f8947c807d7fdcb243ed4dc569713409282d00e2..bba10960ff4b6230c9e9f06c7bf1ab1b3302d263 100644
--- a/src/kernel_services/ast_printing/printer_builder.ml
+++ b/src/kernel_services/ast_printing/printer_builder.ml
@@ -20,54 +20,15 @@
(* *)
(**************************************************************************)
-module Make
- (P: sig class printer: unit -> Printer_api.extensible_printer_type end) =
+module Make_pp
+ (P: sig val printer : unit -> Printer_api.extensible_printer_type end) =
struct
- module type PrinterClass = sig
- class printer : Printer_api.extensible_printer_type
- end
-
- let printer_class_ref =
- ref (module struct class printer = P.printer () end: PrinterClass)
-
- let printer_ref = ref None
-
- module type PrinterExtension = functor (X: PrinterClass) -> PrinterClass
-
- let set_printer p =
- printer_class_ref := p;
- printer_ref := None
-
- let update_printer x =
- let module X = (val x: PrinterExtension) in
- let module Cur = (val !printer_class_ref: PrinterClass) in
- let module Updated = X(Cur) in
- set_printer (module Updated: PrinterClass)
-
- let printer () : Printer_api.extensible_printer_type =
- match !printer_ref with
- | None ->
- let module Printer = (val !printer_class_ref: PrinterClass) in
- let p = new Printer.printer in
- printer_ref := Some p;
- p#reset ();
- p
- | Some p ->
- p#reset ();
- p
-
- let current_printer () = !printer_class_ref
-
- class extensible_printer = P.printer
+ let printer = P.printer
let without_annot f fmt x = (printer ())#without_annot f fmt x
let force_brace f fmt x = (printer ())#force_brace f fmt x
-
- let pp_varname fmt x = (printer())#varname fmt x
-
- (* eta-expansion required for applying side-effect of [printer ()] at the
- right time *)
+ let pp_varname fmt x = (printer ())#varname fmt x
let pp_location fmt x = (printer ())#location fmt x
let pp_constant fmt x = (printer ())#constant fmt x
let pp_ikind fmt x = (printer ())#ikind fmt x
@@ -113,7 +74,7 @@ struct
let pp_variant fmt x = (printer ())#variant fmt x
let pp_from fmt x = (printer ())#from "assigns" fmt x
let pp_full_assigns fmt x = (printer ())#assigns fmt x
- let pp_assigns = pp_full_assigns "assigns"
+ let pp_assigns fmt x = pp_full_assigns "assigns" fmt x
let pp_allocation fmt x = (printer ())#allocation ~isloop:false fmt x
let pp_loop_from fmt x = (printer ())#from "loop assigns" fmt x
let pp_loop_assigns fmt x = (printer ())#assigns "loop assigns" fmt x
@@ -129,6 +90,53 @@ struct
let pp_logic_constant fmt x = (printer ())#logic_constant fmt x
let pp_term_lhost fmt x = (printer ())#term_lhost fmt x
let pp_fundec fmt x = (printer ())#fundec fmt x
+
+end
+
+
+module Make
+ (P: sig class printer: unit -> Printer_api.extensible_printer_type end) =
+struct
+
+ module type PrinterClass = sig
+ class printer : Printer_api.extensible_printer_type
+ end
+
+ let printer_class_ref =
+ ref (module struct class printer = P.printer () end: PrinterClass)
+
+ let printer_ref = ref None
+
+ module type PrinterExtension = functor (X: PrinterClass) -> PrinterClass
+
+ let set_printer p =
+ printer_class_ref := p;
+ printer_ref := None
+
+ let update_printer x =
+ let module X = (val x: PrinterExtension) in
+ let module Cur = (val !printer_class_ref: PrinterClass) in
+ let module Updated = X(Cur) in
+ set_printer (module Updated: PrinterClass)
+
+ let printer () : Printer_api.extensible_printer_type =
+ match !printer_ref with
+ | None ->
+ let module Printer = (val !printer_class_ref: PrinterClass) in
+ let p = new Printer.printer in
+ printer_ref := Some p;
+ p#reset ();
+ p
+ | Some p ->
+ p#reset ();
+ p
+
+ let current_printer () = !printer_class_ref
+
+ class extensible_printer = P.printer
+
+ include Make_pp(struct let printer = printer end)
+
end
(*
diff --git a/src/kernel_services/ast_printing/printer_builder.mli b/src/kernel_services/ast_printing/printer_builder.mli
index 4e433b73d0fde0437a39bc8f3f51ebbfc3becd04..1816cc0ec4249e5e32dfb6c64a87bd1e141110e3 100644
--- a/src/kernel_services/ast_printing/printer_builder.mli
+++ b/src/kernel_services/ast_printing/printer_builder.mli
@@ -20,11 +20,18 @@
(* *)
(**************************************************************************)
-(** Build a full pretty-printer from a pretty-printing class.
+(** Build a dynamic printer that bind all pretty-printers to the
+ object obtained by (P()) *)
+
+module Make_pp
+ (P: sig val printer: unit -> Printer_api.extensible_printer_type end):
+ Printer_api.S_pp
+
+(** Build a full pretty-printer from a pretty-printing class.
@since Fluorine-20130401 *)
module Make
- (P: sig class printer: unit -> Printer_api.extensible_printer_type end):
+ (P: sig class printer: unit -> Printer_api.extensible_printer_type end):
Printer_api.S
(*
diff --git a/src/kernel_services/ast_printing/printer_tag.ml b/src/kernel_services/ast_printing/printer_tag.ml
new file mode 100644
index 0000000000000000000000000000000000000000..023b14d756ba29bfdb59887a107e17a6915b6c1c
--- /dev/null
+++ b/src/kernel_services/ast_printing/printer_tag.ml
@@ -0,0 +1,547 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Localizable API --- *)
+(* -------------------------------------------------------------------------- *)
+
+open Cil_types
+open Cil_datatype
+
+type localizable =
+ | PStmt of (kernel_function * stmt)
+ | PStmtStart of (kernel_function * stmt)
+ | PLval of (kernel_function option * kinstr * lval)
+ | PExp of (kernel_function option * kinstr * exp)
+ | PTermLval of (kernel_function option * kinstr * Property.t * term_lval)
+ | PVDecl of (kernel_function option * kinstr * varinfo)
+ | PGlobal of global
+ | PIP of Property.t
+
+module Localizable =
+ Datatype.Make
+ (struct
+ include Datatype.Undefined
+ type t = localizable
+
+ let name = "Printer_tag.Localizable"
+ let reprs = List.map (fun g -> PGlobal g) Global.reprs
+ let mem_project = Datatype.never_any_project
+
+ let hash = function
+ | PStmtStart (_,s) ->
+ Hashtbl.hash( 0, Stmt.hash s )
+ | PStmt (_,s) ->
+ Hashtbl.hash( 1, Stmt.hash s )
+ | PLval (_,ki,lv) ->
+ Hashtbl.hash( 2, Kinstr.hash ki, Lval.hash lv )
+ | PTermLval(_,ki,pi,lv) ->
+ Hashtbl.hash( 3, Kinstr.hash ki, Property.hash pi, Term_lval.hash lv)
+ | PVDecl(_,_,v) ->
+ Hashtbl.hash( 4, Varinfo.hash v )
+ | PExp(_,_,e) ->
+ Hashtbl.hash( 5, Exp.hash e )
+ | PIP ip ->
+ Hashtbl.hash( 6, Property.hash ip )
+ | PGlobal g ->
+ Hashtbl.hash( 7, Global.hash g )
+
+ let equal l1 l2 = match l1,l2 with
+ | PStmt (_,ki1), PStmt (_,ki2) -> ki1.sid = ki2.sid
+ | PStmtStart (_,ki1), PStmtStart (_,ki2) -> ki1.sid = ki2.sid
+ | PLval (_,ki1,lv1), PLval (_,ki2,lv2) ->
+ Kinstr.equal ki1 ki2 && lv1 == lv2
+ | PTermLval (_,ki1,pi1,lv1), PTermLval (_,ki2,pi2,lv2) ->
+ Kinstr.equal ki1 ki2 && Property.equal pi1 pi2 &&
+ Logic_utils.is_same_tlval lv1 lv2
+ (* [JS 2008/01/21] term_lval are not shared: cannot use == *)
+ | PVDecl (_,_,v1), PVDecl (_,_,v2) -> Varinfo.equal v1 v2
+ | PExp (_,_,e1), PExp(_,_,e2) -> Exp.equal e1 e2
+ | PIP ip1, PIP ip2 -> Property.equal ip1 ip2
+ | PGlobal g1, PGlobal g2 -> Global.equal g1 g2
+ | (PStmt _ | PStmtStart _ | PLval _ | PExp _ | PTermLval _ | PVDecl _
+ | PIP _ | PGlobal _), _
+ -> false
+
+ let pp_ki_loc fmt ki =
+ match ki with
+ | Kglobal -> (* no location, print 'global' *)
+ Format.fprintf fmt "global"
+ | Kstmt st ->
+ Cil_datatype.Location.pretty fmt (Stmt.loc st)
+
+ let pretty fmt = function
+ | PStmtStart (_, s) ->
+ Format.fprintf fmt "LocalizableStart %d (%a)"
+ s.sid Printer.pp_location (Cil_datatype.Stmt.loc s)
+ | PStmt (_, s) ->
+ Format.fprintf fmt "LocalizableStmt %d (%a)"
+ s.sid Printer.pp_location (Cil_datatype.Stmt.loc s)
+ | PLval (_, ki, lv) ->
+ Format.fprintf fmt "LocalizableLval %a (%a)"
+ Printer.pp_lval lv pp_ki_loc ki
+ | PExp (_, ki, lv) ->
+ Format.fprintf fmt "LocalizableExp %a (%a)"
+ Printer.pp_exp lv pp_ki_loc ki
+ | PTermLval (_, ki, _pi, tlv) ->
+ Format.fprintf fmt "LocalizableTermLval %a (%a)"
+ Printer.pp_term_lval tlv pp_ki_loc ki
+ | PVDecl (_, _, vi) ->
+ Format.fprintf fmt "LocalizableVDecl %a" Printer.pp_varinfo vi
+ | PGlobal g ->
+ Format.fprintf fmt "LocalizableGlobal %a" Printer.pp_global g
+ | PIP ip ->
+ Format.fprintf fmt "LocalizableIP %a" Description.pp_property ip
+ end)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Utility Accessors --- *)
+(* -------------------------------------------------------------------------- *)
+
+let kf_of_localizable loc =
+ match loc with
+ | PLval (kf_opt, _, _)
+ | PExp (kf_opt,_,_)
+ | PTermLval(kf_opt, _,_,_)
+ | PVDecl (kf_opt, _, _) -> kf_opt
+ | PStmt (kf, _) | PStmtStart(kf,_) -> Some kf
+ | PIP ip -> Property.get_kf ip
+ | PGlobal (GFun ({svar = vi}, _)) -> Some (Globals.Functions.get vi)
+ | PGlobal _ -> None
+
+let ki_of_localizable loc = match loc with
+ | PLval (_, ki, _)
+ | PExp (_, ki, _)
+ | PTermLval(_, ki,_,_)
+ | PVDecl (_, ki, _) -> ki
+ | PStmt (_, st) | PStmtStart(_, st) -> Kstmt st
+ | PIP ip -> Property.get_kinstr ip
+ | PGlobal _ -> Kglobal
+
+let varinfo_of_localizable loc =
+ match kf_of_localizable loc with
+ | Some kf -> Some (Kernel_function.get_vi kf)
+ | None ->
+ match loc with
+ | PGlobal (GVar (vi, _, _) | GVarDecl (vi, _)
+ | GFunDecl (_, vi, _) | GFun ({svar = vi }, _)) -> Some vi
+ | _ -> None
+
+let loc_of_localizable = function
+ | PStmt (_,st) | PStmtStart(_,st)
+ | PLval (_,Kstmt st,_) | PExp(_,Kstmt st, _)
+ | PTermLval(_,Kstmt st,_,_) ->
+ Stmt.loc st
+ | PIP ip ->
+ (match Property.get_kinstr ip with
+ | Kglobal ->
+ (match Property.get_kf ip with
+ None -> Location.unknown
+ | Some kf -> Kernel_function.get_location kf)
+ | Kstmt st -> Stmt.loc st)
+ | PVDecl (_,_,vi) -> vi.vdecl
+ | PGlobal g -> Global.loc g
+ | (PLval _ | PTermLval _ | PExp _) as localize ->
+ (match kf_of_localizable localize with
+ | None -> Location.unknown
+ | Some kf -> Kernel_function.get_location kf)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Printer API --- *)
+(* -------------------------------------------------------------------------- *)
+
+module type TAG =
+sig
+ val create : localizable -> string
+ val unfold : stmt -> bool
+end
+
+(* We delay the creation of the class to execution time, so that all
+ pretty-printer extensions get properly registered (as we want to inherit
+ from them). The only known solution is to use a functor *)
+module BUILD(Tag : TAG)(X: Printer.PrinterClass) : Printer.PrinterClass =
+struct
+
+ class printer : Printer.extensible_printer = object(self)
+
+ inherit X.printer as super
+
+ val mutable current_property = None
+
+ method private current_kinstr =
+ match self#current_stmt with
+ | None -> Kglobal
+ | Some st -> Kstmt st
+
+ method private current_sid =
+ match super#current_stmt with
+ | None -> assert false
+ | Some st -> st.sid
+
+ method private current_kf =
+ match super#current_function with
+ | None -> None
+ | Some fd -> Some (Globals.Functions.get fd)
+
+ val mutable current_ca = None
+
+ val mutable active_behaviors = []
+
+ method private current_behavior_or_loop =
+ match current_ca with
+ None ->
+ let active = Datatype.String.Set.of_list active_behaviors in
+ Property.Id_contract (active ,Extlib.the self#current_behavior)
+ | Some ca -> Property.Id_loop ca
+
+ (* When [stmt] is a call, this method "inlines" the preconditions of the
+ functions that may be called here, with some context. This way,
+ bullets are more precise, etc. *)
+ method private preconditions_at_call fmt stmt =
+ match stmt.skind with
+ | Instr (Call _)
+ | Instr (Local_init (_, ConsInit _, _)) ->
+ let extract_instance_predicate = function
+ | Property.IPPropertyInstance (_kf, _stmt, pred, _prop) -> pred
+ (* Other cases should not happen, unless a plugin has replaced call
+ preconditions. In this case, print nothing but do not crash. *)
+ | _ -> raise Not_found
+ in
+ let extract_predicate = function
+ | Property.IPPredicate (_, _, _, p) -> p
+ | _ -> assert false
+ in
+ (* Functons called at this point *)
+ let called = Statuses_by_call.all_functions_with_preconditions stmt in
+ let warn_missing = false in
+ let add_by_kf kf acc =
+ let ips =
+ Statuses_by_call.all_call_preconditions_at ~warn_missing kf stmt
+ in
+ if ips = [] then acc else (kf, ips) :: acc
+ in
+ let ips_all_kfs = Kernel_function.Hptset.fold add_by_kf called [] in
+ let pp_one fmt (original_p, p) =
+ match extract_instance_predicate p with
+ | Some pred -> Format.fprintf fmt "@[%a@]" self#requires_aux (p, pred)
+ | None ->
+ let pred = extract_predicate original_p in
+ (* Makes the original predicate non clickable, as it may involve
+ the formal parameters which are not in scope at the call site. *)
+ Format.fprintf fmt "@[Non transposable: %s@]"
+ (Format.asprintf "@[%a@]" self#requires_aux (original_p, pred))
+ | exception Not_found -> ()
+ in
+ let pp_by_kf fmt (kf, ips) =
+ Format.fprintf fmt "@[preconditions of %a:@]@ %a"
+ Kernel_function.pretty kf
+ (Pretty_utils.pp_list ~pre:"" ~sep:"@ " ~suf:"" pp_one) ips
+ in
+ if ips_all_kfs <> [] then
+ Pretty_utils.pp_list ~pre:"@[<v 3>/* " ~sep:"@ " ~suf:" */@]@ "
+ pp_by_kf fmt ips_all_kfs
+ | _ -> ()
+
+
+ method! next_stmt next fmt current =
+ if Tag.unfold current
+ then self#preconditions_at_call fmt current;
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PStmt (Extlib.the self#current_kf,current)))
+ (super#next_stmt next) current
+
+ method! lval fmt lv =
+ match self#current_kinstr with
+ | Kglobal -> super#lval fmt lv
+ (* Do not highlight the lvals in initializers. *)
+ | Kstmt _ as ki ->
+ Format.fprintf fmt "@{<%s>"
+ (Tag.create (PLval (self#current_kf,ki,lv)));
+ (match lv with
+ | Var vi, (Field _| Index _ as o) ->
+ (* Small hack to be able to click on the arrays themselves
+ in the easy cases *)
+ self#lval fmt (Var vi, NoOffset);
+ self#offset fmt o
+ | _ -> super#lval fmt lv
+ );
+ Format.fprintf fmt "@}"
+
+ method! exp fmt e =
+ match e.enode with
+ | Lval lv ->
+ (* Do not mark immediate l-values as they would not be
+ selectable anyway because of the embedded tags of self#lval.
+ This is only an optimization. *)
+ self#lval fmt lv
+ | _ ->
+ Format.fprintf fmt "@{<%s>"
+ (Tag.create (PExp (self#current_kf,self#current_kinstr,e)));
+ super#exp fmt e;
+ Format.fprintf fmt "@}"
+
+ method! term_lval fmt lv =
+ (* similar to pLval, except that term_lval can appear in specifications
+ of functions (ki = None, kf <> None). Initializers are ignored. *)
+ if self#current_kinstr = Kglobal && self#current_kf = None then begin
+ super#term_lval fmt lv (* Do not highlight the lvals in initializers. *)
+ end else begin
+ match current_property with
+ | None -> (* Also use default printer for this case (possible inside
+ pragmas, for example). *)
+ super#term_lval fmt lv
+ | Some ip ->
+ Format.fprintf fmt "@{<%s>"
+ (Tag.create
+ (PTermLval (self#current_kf, self#current_kinstr, ip, lv)));
+ (match lv with
+ | TVar vi, (TField _| TIndex _ as o) ->
+ self#term_lval fmt (TVar vi, TNoOffset);
+ self#term_offset fmt o
+ | _ -> super#term_lval fmt lv
+ );
+ Format.fprintf fmt "@}"
+ end
+
+ method! vdecl fmt vi =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PVDecl (self#current_kf, self#current_kinstr, vi)))
+ super#vdecl vi
+
+ method private tag_property p =
+ current_property <- Some p;
+ Tag.create (PIP p)
+
+ method! code_annotation fmt ca =
+ match ca.annot_content with
+ | APragma p when not (Logic_utils.is_property_pragma p) ->
+ (* Not currently localizable. Will be linked to the next stmt *)
+ super#code_annotation fmt ca
+ | AAssert _ | AInvariant _ | APragma _ | AVariant _ ->
+ let ip =
+ Property.ip_of_code_annot_single
+ (Extlib.the self#current_kf)
+ (Extlib.the self#current_stmt)
+ ca
+ in
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property ip)
+ super#code_annotation ca;
+ | AStmtSpec (active,_) | AExtended(active,_,_) ->
+ (* tags will be set in the inner nodes. *)
+ active_behaviors <- active;
+ super#code_annotation fmt ca;
+ active_behaviors <- [];
+ | AAllocation _
+ | AAssigns _ ->
+ (* tags will be set in the inner nodes. *)
+ current_ca <- Some ca;
+ super#code_annotation fmt ca;
+ current_ca <- None
+
+ method! global fmt g =
+ match g with
+ (* these globals are already covered by PVDecl *)
+ | GVarDecl _ | GVar _ | GFunDecl _ | GFun _ -> super#global fmt g
+ | _ ->
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PGlobal g))
+ super#global
+ g
+
+ method! extended fmt ext =
+ let loc =
+ match self#current_kf with
+ | None -> Property.ELGlob
+ | Some kf -> Property.e_loc_of_stmt kf self#current_kinstr
+ in
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property Property.(ip_of_extended loc ext))
+ super#extended ext;
+
+ method private requires_aux fmt (ip, p) =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property ip)
+ super#requires p;
+
+ method! requires fmt p =
+ let b = Extlib.the self#current_behavior in
+ let ip =
+ Property.ip_of_requires
+ (Extlib.the self#current_kf) self#current_kinstr b p
+ in
+ self#requires_aux fmt (ip, p)
+
+ method! behavior fmt b =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_behavior
+ (Extlib.the self#current_kf)
+ self#current_kinstr
+ active_behaviors b))
+ super#behavior b
+
+ method! decreases fmt t =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_decreases
+ (Extlib.the self#current_kf) self#current_kinstr t))
+ super#decreases t;
+
+ method! terminates fmt t =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_terminates
+ (Extlib.the self#current_kf) self#current_kinstr t))
+ super#terminates t;
+
+ method! complete_behaviors fmt t =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_complete
+ (Extlib.the self#current_kf)
+ self#current_kinstr
+ active_behaviors
+ t))
+ super#complete_behaviors t
+
+ method! disjoint_behaviors fmt t =
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_disjoint
+ (Extlib.the self#current_kf)
+ self#current_kinstr
+ active_behaviors
+ t))
+ super#disjoint_behaviors t
+
+ method! assumes fmt p =
+ let b = Extlib.the self#current_behavior in
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_assumes
+ (Extlib.the self#current_kf) self#current_kinstr b p))
+ super#assumes p;
+
+ method! post_cond fmt pc =
+ let b = Extlib.the self#current_behavior in
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property
+ (Property.ip_of_ensures
+ (Extlib.the self#current_kf) self#current_kinstr b pc))
+ super#post_cond pc;
+
+ method! assigns s fmt a =
+ match
+ Property.ip_of_assigns (Extlib.the self#current_kf) self#current_kinstr
+ self#current_behavior_or_loop a
+ with
+ None -> super#assigns s fmt a
+ | Some ip ->
+ Format.fprintf fmt "@{<%s>%a@}"
+ (self#tag_property ip) (super#assigns s) a
+
+ method! from s fmt ((_, f) as from) =
+ match f with
+ | FromAny -> super#from s fmt from
+ | From _ ->
+ let ip =
+ Extlib.the
+ (Property.ip_of_from
+ (Extlib.the self#current_kf) self#current_kinstr
+ self#current_behavior_or_loop from)
+ in
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PIP ip)) (super#from s) from
+
+ method! global_annotation fmt a =
+ match Property.ip_of_global_annotation_single a with
+ | None -> super#global_annotation fmt a
+ | Some ip ->
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PIP ip)) super#global_annotation a
+
+ method! allocation ~isloop fmt a =
+ match
+ Property.ip_of_allocation (Extlib.the self#current_kf) self#current_kinstr
+ self#current_behavior_or_loop a
+ with
+ None -> super#allocation ~isloop fmt a
+ | Some ip ->
+ Format.fprintf fmt "@{<%s>%a@}"
+ (Tag.create (PIP ip)) (super#allocation ~isloop) a;
+
+ method! stmtkind sattr next fmt sk =
+ (* Special tag denoting the start of the statement, WITHOUT any ACSL
+ assertion/statement contract, etc. *)
+ let s = Extlib.the self#current_stmt in
+ let f = Extlib.the self#current_kf in
+ let tag = Tag.create (PStmtStart(f,s)) in
+ Format.fprintf fmt "@{<%s>%a@}" tag (super#stmtkind sattr next) sk
+
+ initializer force_brace <- true
+
+ end
+end
+
+module type Tag =
+sig
+ val create : localizable -> string
+end
+
+module type S_pp =
+sig
+ include Printer_api.S_pp
+ val with_unfold_precond : (stmt -> bool) ->
+ (Format.formatter -> 'a -> unit) ->
+ (Format.formatter -> 'a -> unit)
+end
+
+module Make(T : Tag) =
+struct
+
+ let unfold = ref (fun (_ : stmt) -> false)
+
+ let printer =
+ let pref : Printer.extensible_printer option ref = ref None in
+ fun () ->
+ match !pref with Some pp -> pp | None ->
+ let pp = Printer.current_printer () in
+ let module PP = (val pp: Printer.PrinterClass) in
+ let module TAG = struct
+ let create = T.create
+ let unfold s = !unfold s
+ end in
+ let module TagPrinterClass = BUILD(TAG)(PP) in
+ let printer = new TagPrinterClass.printer in
+ pref := Some printer ; printer
+
+ let with_unfold_precond unfolder f fmt x =
+ let stack = !unfold in
+ try unfold := unfolder ; f fmt x ; unfold := stack
+ with err -> unfold := stack ; raise err
+
+ include Printer_builder.Make_pp(struct let printer = printer end)
+
+end
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/kernel_services/ast_printing/printer_tag.mli b/src/kernel_services/ast_printing/printer_tag.mli
new file mode 100644
index 0000000000000000000000000000000000000000..f73418ed2cdad25390cb63d18d6047b0ee14035e
--- /dev/null
+++ b/src/kernel_services/ast_printing/printer_tag.mli
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+(** Utilities to pretty print source with located Ast elements *)
+
+open Cil_types
+
+(** The kind of object that can be selected in the source viewer. *)
+type localizable =
+ | PStmt of (kernel_function * stmt)
+ | PStmtStart of (kernel_function * stmt)
+ | PLval of (kernel_function option * kinstr * lval)
+ | PExp of (kernel_function option * kinstr * exp)
+ | PTermLval of (kernel_function option * kinstr * Property.t * term_lval)
+ | PVDecl of (kernel_function option * kinstr * varinfo)
+ (** Declaration and definition of variables and function. Check the type
+ of the varinfo to distinguish between the various possibilities.
+ If the varinfo is a global or a local, the kernel_function is the
+ one in which the variable is declared. The [kinstr] argument is given
+ for local variables with an explicit initializer. *)
+ | PGlobal of global (** all globals but variable declarations and function
+ definitions. *)
+ | PIP of Property.t
+
+module Localizable: Datatype.S with type t = localizable
+
+val kf_of_localizable : localizable -> kernel_function option
+val ki_of_localizable : localizable -> kinstr
+val varinfo_of_localizable : localizable -> varinfo option
+val loc_of_localizable : localizable -> location
+(** Might return [Location.unknown] *)
+
+module type Tag =
+sig
+ val create : localizable -> string
+end
+
+module type S_pp =
+sig
+ include Printer_api.S_pp
+ val with_unfold_precond : (stmt -> bool) ->
+ (Format.formatter -> 'a -> unit) ->
+ (Format.formatter -> 'a -> unit)
+end
+
+module Make(T : Tag) : S_pp
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/kernel_services/ast_queries/cil.ml b/src/kernel_services/ast_queries/cil.ml
index 86eb84205298d80638abceaf63fc096dda62aa85..027a3758727e31a37b87840c49e4f65172cc7793 100644
--- a/src/kernel_services/ast_queries/cil.ml
+++ b/src/kernel_services/ast_queries/cil.ml
@@ -2931,14 +2931,15 @@ and childrenBehavior vis b =
b.b_extended <- mapNoCopy (visitCilExtended vis) b.b_extended;
b
-and visitCilExtended vis (i,s,l,p as orig) =
+and visitCilExtended vis (i,a,l,s,e as orig) =
let visit =
- try Hashtbl.find visitor_tbl s
+ try Hashtbl.find visitor_tbl a
with Not_found -> (fun _ _ -> DoChildren)
in
- let p' = doVisitCil vis id (visit vis) childrenCilExtended p in
- if is_fresh_behavior vis#behavior then Logic_const.new_acsl_extension s l p
- else if p == p' then orig else (i,s,l,p')
+ let e' = doVisitCil vis id (visit vis) childrenCilExtended e in
+ if is_fresh_behavior vis#behavior then
+ Logic_const.new_acsl_extension a l s e'
+ else if e == e' then orig else (i,a,l,s,e')
and childrenCilExtended vis p =
match p with
@@ -3994,7 +3995,7 @@ let truncateInteger64 (k: ikind) i =
let i' =
let nrBits = Integer.of_int (8 * (bytesSizeOfInt k)) in
let max_strict_bound = Integer.shift_left Integer.one nrBits in
- let modulo = Integer.pos_rem i max_strict_bound in
+ let modulo = Integer.e_rem i max_strict_bound in
let signed = isSigned k in
if signed then
let max_signed_strict_bound =
@@ -5034,7 +5035,7 @@ and intOfAttrparam (a:attrparam) : int option =
let n = doit a in
ignoreAlignmentAttrs := false;
Some n
- with Failure _ | SizeOfError _ -> (* Can't compile *)
+ with Z.Overflow | SizeOfError _ -> (* Can't compile *)
ignoreAlignmentAttrs := false;
None
and process_aligned_attribute (pp:Format.formatter->unit) ~may_reduce attrs default_align =
@@ -5309,7 +5310,7 @@ and offsetOfFieldAcc_GCC last (fi: fieldinfo) (sofar: offsetAcc) : offsetAcc =
let sz' =
try
Integer.to_int sz
- with Failure _ ->
+ with Z.Overflow ->
raise
(SizeOfError
("Array is so long that its size can't be "
diff --git a/src/kernel_services/ast_queries/cil_datatype.ml b/src/kernel_services/ast_queries/cil_datatype.ml
index 634eb66b2073c730f0e81b163e457b71c957c347..3c944847e4e219637f04ad1d2ab481d3c32ea781 100644
--- a/src/kernel_services/ast_queries/cil_datatype.ml
+++ b/src/kernel_services/ast_queries/cil_datatype.ml
@@ -1932,7 +1932,7 @@ module Global_annotation = struct
if res = 0 then Attributes.compare attr1 attr2 else res
| Dcustom_annot _, _ -> -1
| _, Dcustom_annot _ -> 1
- | Dextended ((id1,_,_,_),_,_), Dextended((id2,_,_,_),_,_) ->
+ | Dextended ((id1,_,_,_,_),_,_), Dextended((id2,_,_,_,_),_,_) ->
Datatype.Int.compare id1 id2
let equal = Datatype.from_compare
@@ -1952,7 +1952,7 @@ module Global_annotation = struct
| Dtype_annot(l,_) -> 17 * Logic_info.hash l
| Dmodel_annot(l,_) -> 19 * Model_info.hash l
| Dcustom_annot(_,n,_,_) -> 23 * Datatype.String.hash n
- | Dextended ((id,_,_,_),_,_) -> 29 * Datatype.Int.hash id
+ | Dextended ((id,_,_,_,_),_,_) -> 29 * Datatype.Int.hash id
let copy = Datatype.undefined
end)
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index eb8c87f31fb8609cf32f555fb36e40a3c18e6d71..0632240c7cabaf813a28d995b8a73d938b2bdb40 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -733,7 +733,7 @@ let synchronize_source_annot has_new_stmt kf =
match annot.annot_content with
| AStmtSpec _ | APragma (Slice_pragma SPstmt | Impact_pragma IPstmt)
-> true
- | AExtended(_,is_loop,(_,name,_,_)) ->
+ | AExtended(_,is_loop,(_,name,_,_,_)) ->
(match Logic_env.extension_category name with
| Some (Ext_code_annot (Ext_here | Ext_next_loop)) -> false
| Some (Ext_code_annot Ext_next_stmt) -> true
diff --git a/src/kernel_services/ast_queries/filecheck.ml b/src/kernel_services/ast_queries/filecheck.ml
index d9769c7e6d957dcf0031a5bedccf8c9ecab785c4..3b292cce6677521f1dceb355c4642eef80ab9781 100644
--- a/src/kernel_services/ast_queries/filecheck.ml
+++ b/src/kernel_services/ast_queries/filecheck.ml
@@ -615,7 +615,7 @@ class check ?(is_normalized=true) what : Visitor.frama_c_visitor =
in
let my_labels =
match ca.annot_content with
- | AExtended (_, is_loop, (_, name, _, _)) ->
+ | AExtended (_, is_loop, (_, name, _, _, _)) ->
(match Logic_env.extension_category name, is_loop with
| Some (Ext_code_annot (Ext_next_stmt | Ext_next_both)), false ->
Logic_const.post_label :: my_labels
diff --git a/src/kernel_services/ast_queries/logic_const.ml b/src/kernel_services/ast_queries/logic_const.ml
index 61114f0c37af579d784cc9e23106db3f0ddcaed8..6a5e1cebc9ca2c9f3053407171369a1fbc34cdf7 100644
--- a/src/kernel_services/ast_queries/logic_const.ml
+++ b/src/kernel_services/ast_queries/logic_const.ml
@@ -55,8 +55,8 @@ let refresh_predicate p = { p with ip_id = PredicateId.next () }
let new_identified_term t =
{ it_id = TermId.next (); it_content = t }
-let new_acsl_extension name l p =
- ExtendedId.next (),name, l, p
+let new_acsl_extension name l s k : acsl_extension =
+ ExtendedId.next (), name, l, s , k
let fresh_term_id = TermId.next
diff --git a/src/kernel_services/ast_queries/logic_const.mli b/src/kernel_services/ast_queries/logic_const.mli
index 75813d76de60c4eb44c2a57a4165f2a6f74bf612..e724d727a1c8584a4b76a446f64136a5f8145697 100644
--- a/src/kernel_services/ast_queries/logic_const.mli
+++ b/src/kernel_services/ast_queries/logic_const.mli
@@ -49,13 +49,14 @@ val refresh_spec: funspec -> funspec
(** creates a new identified predicate with a fresh id. *)
val new_predicate: predicate -> identified_predicate
-(** creat a new acsl_extension with a fresh id.
+(** creates a new acsl_extension with a fresh id.
@plugin development guide
@since Chlorine-20180501
*)
-val new_acsl_extension: string -> location -> acsl_extension_kind -> acsl_extension
+val new_acsl_extension:
+ string -> location -> bool -> acsl_extension_kind -> acsl_extension
-(** Gives a new id to an existing predicate.
+(** Gives a new id to an existing predicate.
@since Oxygen-20120901
*)
val refresh_predicate: identified_predicate -> identified_predicate
diff --git a/src/kernel_services/ast_queries/logic_typing.ml b/src/kernel_services/ast_queries/logic_typing.ml
index c08ee2865a60efb4ba15286969b41bf8c63cb094..918ca0447b734454367bde0b04082b03bec3ff96 100644
--- a/src/kernel_services/ast_queries/logic_typing.ml
+++ b/src/kernel_services/ast_queries/logic_typing.ml
@@ -507,19 +507,20 @@ module Extensions = struct
let typer_tbl = Hashtbl.create 5
let find_typer name = Hashtbl.find typer_tbl name
let is_extension name = Hashtbl.mem typer_tbl name
- let register name category typer =
+ let register name category status typer =
if is_extension name then
Kernel.warning ~wkey:Kernel.wkey_acsl_extension
"Trying to register ACSL extension %s twice. Ignoring second extension"
name
else begin
Logic_env.register_extension name category;
- Hashtbl.add typer_tbl name typer
+ Hashtbl.add typer_tbl name (status,typer)
end
let typer name ~typing_context:typing_context ~loc p =
- try let typ = find_typer name in
- typ ~typing_context ~loc p
+ try
+ let status,typer = find_typer name in
+ status, typer ~typing_context ~loc p
with Not_found ->
Kernel.fatal ~source:(fst loc) "unsupported clause of name '%s'" name
end
@@ -1693,7 +1694,8 @@ struct
- let conditional_conversion loc env t1 t2 =
+ let conditional_conversion loc env rel t1 t2 =
+ let is_rel = Extlib.has_some rel in
(* a comparison is mainly a function of type 'a -> 'a -> Bool/Prop.
performs the needed unifications on both sides.*)
let var = fresh_type_var "cmp" in
@@ -1709,10 +1711,10 @@ struct
in
let rec aux lty1 lty2 =
match (unroll_type lty1), (unroll_type lty2) with
- | t1, t2 when is_same_type t1 t2 -> t1
| Ctype ty1, Ctype ty2 ->
if isIntegralType ty1 && isIntegralType ty2 then
- if (isSignedInteger ty1) <> (isSignedInteger ty2) then
+ if is_same_type lty1 lty2 then lty1
+ else if (isSignedInteger ty1) <> (isSignedInteger ty2) then
(* in ACSL, the comparison between 0xFFFFFFFF seen as int and
unsigned int is not true: we really have to operate at
the integer level.
@@ -1724,9 +1726,25 @@ struct
else if is_enum_cst t1 lty2 then lty2
else if is_enum_cst t2 lty1 then lty1
else Ctype (C.conditionalConversion ty1 ty2)
- else if isArithmeticType ty1 && isArithmeticType ty2 then
- Lreal
- else if is_same_ptr_type ty1 ty2 || is_same_array_type ty1 ty2 then
+ else if isArithmeticType ty1 && isArithmeticType ty2 then begin
+ if is_same_type lty1 lty2 then begin
+ if is_rel then begin
+ let rel = Extlib.the rel in
+ let kind =
+ match Cil.unrollType ty1 with
+ | TFloat (FFloat,_) -> "float"
+ | TFloat (FDouble,_) -> "double"
+ | TFloat (FLongDouble,_) -> "long double"
+ | _ -> Kernel.fatal "floating point type expected"
+ in
+ let source = fst loc in
+ Kernel.warning ~source ~wkey:Kernel.wkey_acsl_float_compare
+ "comparing two %s values as real values. You might \
+ want to use \\%s_%s instead" kind rel kind;
+ Lreal
+ end else lty1
+ end else Lreal
+ end else if is_same_ptr_type ty1 ty2 || is_same_array_type ty1 ty2 then
Ctype (C.conditionalConversion ty1 ty2)
else if
(isPointerType ty1 || isArrayType ty1) &&
@@ -1759,6 +1777,7 @@ struct
(* implicit conversion to set *)
| Ltype ({lt_name = "set"} as lt,[t1]), t2
| t1, Ltype({lt_name="set"} as lt,[t2]) -> Ltype(lt,[aux t1 t2])
+ | t1, t2 when is_same_type t1 t2 -> t1
| _ ->
C.error loc "types %a and %a are not convertible"
Cil_printer.pp_logic_type lty1 Cil_printer.pp_logic_type lty2
@@ -2735,7 +2754,7 @@ struct
let t2 = term env t2 in
let t3 = term env t3 in
let env,ty,ty2,ty3 =
- conditional_conversion loc env t2 t3 in
+ conditional_conversion loc env None t2 t3 in
let t2 = { t2 with term_type = instantiate env t2.term_type } in
let _,t2 =
implicit_conversion
@@ -2976,7 +2995,6 @@ struct
and type_relation:
'a. _ -> _ -> (_ -> _ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a =
fun ctxt env f t1 op t2 ->
- let module C = struct end in
let loc1 = t1.lexpr_loc in
let loc2 = t2.lexpr_loc in
let loc = loc_join t1.lexpr_loc t2.lexpr_loc in
@@ -2984,9 +3002,17 @@ struct
let ty1 = t1.term_type in
let t2 = ctxt.type_term ctxt env t2 in
let ty2 = t2.term_type in
+ let rel = match op with
+ | Eq -> "eq"
+ | Neq -> "ne"
+ | Le -> "le"
+ | Lt -> "lt"
+ | Ge -> "ge"
+ | Gt -> "gt"
+ in
let conditional_conversion t1 t2 =
let env,t,ty1,ty2 =
- conditional_conversion loc env t1 t2
+ conditional_conversion loc env (Some rel) t1 t2
in
let t1 = { t1 with term_type = instantiate env t1.term_type } in
let _,t1 =
@@ -3554,7 +3580,8 @@ struct
| p::_ -> p.lexpr_loc
in
if Extensions.is_extension name then
- Logic_const.new_acsl_extension name loc (Extensions.typer name ~typing_context ~loc ps)
+ let status , kind = Extensions.typer name ~typing_context ~loc ps in
+ Logic_const.new_acsl_extension name loc status kind
else
C.error
loc "No type-checking function registered for extension %s" name
@@ -4176,8 +4203,8 @@ struct
Dvolatile (tsets, rvi_opt, wvi_opt, [], loc)
| LDextended (kind, content) ->
let typing_context = base_ctxt (Lenv.empty ()) in
- let tcontent = Extensions.typer kind ~typing_context ~loc content in
- let textended = Logic_const.new_acsl_extension kind loc tcontent in
+ let status,tcontent = Extensions.typer kind ~typing_context ~loc content in
+ let textended = Logic_const.new_acsl_extension kind loc status tcontent in
Dextended (textended, [], loc)
let annot a =
diff --git a/src/kernel_services/ast_queries/logic_typing.mli b/src/kernel_services/ast_queries/logic_typing.mli
index d6c27a03d9228306a4d0841a24aa1e78666341fd..a05bd2a0ebba3432098286cae6c3596702b3463c 100644
--- a/src/kernel_services/ast_queries/logic_typing.mli
+++ b/src/kernel_services/ast_queries/logic_typing.mli
@@ -147,9 +147,14 @@ type typing_context = {
on_error: 'a 'b. ('a -> 'b) -> (unit -> unit) -> 'a -> 'b
}
-(** [register_behavior_extension name f] registers a typing function [f] to
+(** [register_behavior_extension name status f] registers a
+ typing function [f] to
be used to type function contract clause with name [name].
+ The boolean flags specifies if the extension can be assigned
+ a property status or not.
+
Here is a basic example:
+
let count = ref 0 in
let foo_typer ~typing_context ~loc ps =
match ps with p::[] ->
@@ -161,7 +166,7 @@ type typing_context = {
p)])
| [] -> let id = !count in incr count; Ext_id id
| _ -> typing_context.error loc "expecting a predicate after keyword FOO"
- let () = register_behavior_extension "FOO" foo_typer
+ let () = register_behavior_extension "FOO" false foo_typer
@plugin development guide
@@ -169,7 +174,7 @@ type typing_context = {
@modify Silicon-20161101 change type of the function
*)
val register_behavior_extension:
- string ->
+ string -> bool ->
(typing_context:typing_context -> loc:location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
@@ -180,7 +185,7 @@ val register_behavior_extension:
@since 18.0-Argon
*)
val register_global_extension:
- string ->
+ string -> bool ->
(typing_context:typing_context -> loc: location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
@@ -192,7 +197,7 @@ val register_global_extension:
@since 18.0-Argon
*)
val register_code_annot_extension:
- string ->
+ string -> bool ->
(typing_context: typing_context -> loc: location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
@@ -204,7 +209,7 @@ val register_code_annot_extension:
@since 18.0-Argon
*)
val register_code_annot_next_stmt_extension:
- string ->
+ string -> bool ->
(typing_context: typing_context -> loc: location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
@@ -215,7 +220,7 @@ val register_code_annot_next_stmt_extension:
@since 18.0-Argon
*)
val register_code_annot_next_loop_extension:
- string ->
+ string -> bool ->
(typing_context: typing_context -> loc: location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
@@ -227,7 +232,7 @@ val register_code_annot_next_loop_extension:
@since 18.0-Argon
*)
val register_code_annot_next_both_extension:
- string ->
+ string -> bool ->
(typing_context: typing_context -> loc: location ->
Logic_ptree.lexpr list -> acsl_extension_kind) -> unit
diff --git a/src/kernel_services/ast_queries/logic_utils.ml b/src/kernel_services/ast_queries/logic_utils.ml
index 0a7ec7f9bd67fe6ebfa6465c2b1d4de18a4c9a73..9ad4de7713352889d31e310614767229efa173fa 100644
--- a/src/kernel_services/ast_queries/logic_utils.ml
+++ b/src/kernel_services/ast_queries/logic_utils.ml
@@ -1008,8 +1008,9 @@ let is_same_pragma p1 p2 =
| Impact_pragma p1, Impact_pragma p2 -> is_same_impact_pragma p1 p2
| (Loop_pragma _ | Slice_pragma _ | Impact_pragma _), _ -> false
-let is_same_extension (_,e1, _,c1) (_,e2, _,c2) =
+let is_same_extension (_,e1,_,s1,c1) (_,e2,_,s2,c2) =
Datatype.String.equal e1 e2 &&
+ (s1 = s2) &&
match c1, c2 with
| Ext_id i1, Ext_id i2 -> i1 = i2
| Ext_terms t1, Ext_terms t2 ->
@@ -2345,9 +2346,9 @@ and constFoldBinOpToInt ~machdep bop e1 e2 =
| PlusPI | IndexPI | MinusPI | MinusPP -> None
| Mult -> Some (Integer.mul i1 i2)
| Div ->
- if Integer.(equal zero i2) && Integer.(is_zero (rem i1 i2)) then None
- else Some (Integer.div i1 i2)
- | Mod -> if Integer.(equal zero i2) then None else Some (Integer.rem i1 i2)
+ if Integer.(equal zero i2) && Integer.(is_zero (e_rem i1 i2)) then None
+ else Some (Integer.e_div i1 i2)
+ | Mod -> if Integer.(equal zero i2) then None else Some (Integer.e_rem i1 i2)
| BAnd -> Some (Integer.logand i1 i2)
| BOr -> Some (Integer.logor i1 i2)
| BXor -> Some (Integer.logxor i1 i2)
@@ -2376,8 +2377,8 @@ and constFoldToffset t =
try
let start, _width = bitsLogicOffset v.lv_type offset in
let size_char = Integer.eight in
- if Integer.(is_zero (rem start size_char)) then
- Some (Integer.div start size_char)
+ if Integer.(is_zero (e_rem start size_char)) then
+ Some (Integer.e_div start size_char)
else None (* bitfields *)
with Cil.SizeOfError _ -> None
end
diff --git a/src/kernel_services/plugin_entry_points/kernel.ml b/src/kernel_services/plugin_entry_points/kernel.ml
index 5063b344f1198a3ea61441f44345d12062bb7e8b..9c0399ad475d798fd4f968f5fae4bf5175b29eb7 100644
--- a/src/kernel_services/plugin_entry_points/kernel.ml
+++ b/src/kernel_services/plugin_entry_points/kernel.ml
@@ -131,6 +131,9 @@ let dkey_visitor = register_category "visitor"
let wkey_annot_error = register_warn_category "annot-error"
let () = set_warn_status wkey_annot_error Log.Wabort
+let wkey_acsl_float_compare = register_warn_category "acsl-float-compare"
+let () = set_warn_status wkey_acsl_float_compare Log.Winactive
+
let wkey_drop_unused = register_warn_category "linker:drop-conflicting-unused"
let wkey_implicit_conv_void_ptr =
diff --git a/src/kernel_services/plugin_entry_points/kernel.mli b/src/kernel_services/plugin_entry_points/kernel.mli
index a5d8940582debc50495088b2b85b87e2610f9678..bc130617463ae326596dafb96a28133d71449c03 100644
--- a/src/kernel_services/plugin_entry_points/kernel.mli
+++ b/src/kernel_services/plugin_entry_points/kernel.mli
@@ -128,6 +128,8 @@ val dkey_visitor: category
val wkey_annot_error: warn_category
(** error in annotation. If only a warning, annotation will just be ignored. *)
+val wkey_acsl_float_compare: warn_category
+
val wkey_drop_unused: warn_category
val wkey_implicit_conv_void_ptr: warn_category
diff --git a/src/libraries/project/state_builder.ml b/src/libraries/project/state_builder.ml
index de752d5a942768757f3a238c5e01d66dfa1431da..9a5f3e47cff7ff8e4a9c2670a836a82ca6e741dd 100644
--- a/src/libraries/project/state_builder.ml
+++ b/src/libraries/project/state_builder.ml
@@ -1022,7 +1022,10 @@ module type Hashcons = sig
end
-module Hashcons (Data: Datatype.S)(Info: Info) = struct
+module Hashcons
+ (Data: Datatype.S)
+ (Info: sig include Info val initial_values: Data.t list end)
+= struct
type elt = Data.t
@@ -1053,13 +1056,24 @@ module Hashcons (Data: Datatype.S)(Info: Info) = struct
include D
+ let counter = ref 0
+
+ (* Only used for the initial values, that must be all different. *)
+ let unsafe_hashcons key =
+ let r = { key; id = !counter } in
+ incr counter;
+ r
+
module HashConsTbl =
Hashconsing_tbl
(struct
include D
let hash_internal a = Data.hash a.key
let equal_internal a b = Data.equal a.key b.key
- let initial_values = [] (* TODO? *)
+ let initial_values =
+ (* Ensures that the initial values are all different. *)
+ let uniq_values = List.sort_uniq Data.compare Info.initial_values in
+ List.map unsafe_hashcons uniq_values
end)
(struct
let name = "Hashconstable(" ^ Data.name ^ "," ^ Info.name ^ ")"
@@ -1069,15 +1083,12 @@ module Hashcons (Data: Datatype.S)(Info: Info) = struct
let self = HashConsTbl.self
- let counter = ref 0
-
let hashcons key =
- let id = !counter in
- let hashed_atom = { key; id } in
+ let hashed_atom = { key; id = !counter } in
let hashconsed_atom = HashConsTbl.merge hashed_atom in
if hashconsed_atom.id = !counter then
(* Fresh new atom. this counter id is used. *)
- counter := succ !counter;
+ incr counter;
hashconsed_atom
let () = rehash_ref := fun x -> hashcons x.key
diff --git a/src/libraries/project/state_builder.mli b/src/libraries/project/state_builder.mli
index e328a4012d9c9b7fd89f909e65945be2ea594a97..4dcb71335ce31c28052a37469838d9c0aa0a593c 100644
--- a/src/libraries/project/state_builder.mli
+++ b/src/libraries/project/state_builder.mli
@@ -484,7 +484,15 @@ module type Hashcons = sig
end
(** Hashconsed version of an arbitrary datatype *)
-module Hashcons (Data: Datatype.S)(Info: Info) : Hashcons with type elt = Data.t
+module Hashcons
+ (Data: Datatype.S)
+ (Info: sig
+ include Info
+ val initial_values: Data.t list
+ (** List of values created at compile-time, that must be shared between
+ all instances of Frama-C. *)
+ end)
+ : Hashcons with type elt = Data.t
(* ************************************************************************* *)
diff --git a/src/libraries/stdlib/integer.ml b/src/libraries/stdlib/integer.ml
index 1a7e593f79aede19b4ecddaf53d51964fa7020ce..97b5017821d6b258bccb3cc9d22f1ac4e0655d83 100644
--- a/src/libraries/stdlib/integer.ml
+++ b/src/libraries/stdlib/integer.ml
@@ -22,277 +22,222 @@
type t = Z.t
-exception Too_big
-
let equal = Z.equal
let compare = Z.compare
-
let two_power_of_int k =
Z.shift_left Z.one k
-let two_power y =
- try
- let k = Z.to_int y in
- if k > 1024 then
- (* avoid memory explosion *)
- raise Too_big
- else
- two_power_of_int k
- with Z.Overflow -> raise Too_big
-
-let popcount = Z.popcount
+let two_power n =
+ let k = Z.to_int n in
+ if k > 1024 then
+ raise Z.Overflow
+ else
+ two_power_of_int k
- let zero = Z.zero
- let one = Z.one
- let minus_one = Z.minus_one
- let two = Z.of_int 2
- let four = Z.of_int 4
- let eight = Z.of_int 8
- let sixteen = Z.of_int 16
- let thirtytwo = Z.of_int 32
- let onethousand = Z.of_int 1000
- let billion_one = Z.of_int 1_000_000_001
- let two_power_32 = two_power_of_int 32
- let two_power_60 = two_power_of_int 60
- let two_power_64 = two_power_of_int 64
-
- let is_zero v = Z.equal v Z.zero
-
- let add = Z.add
- let sub = Z.sub
- let succ = Z.succ
- let pred = Z.pred
- let neg = Z.neg
-
- let rem = Z.erem
- let div = Z.ediv
- let mul = Z.mul
-
- let abs = Z.abs
-
- let hash = Z.hash
-
- let shift_left x y = Z.shift_left x (Z.to_int y)
- let shift_right x y = Z.shift_right x (Z.to_int y)
- let shift_right_logical x y = (* no meaning for negative value of x *)
- if (Z.lt x Z.zero)
- then failwith "log_shift_right_big_int"
- else Z.shift_right x (Z.to_int y)
-
- let logand = Z.logand
- let lognot = Z.lognot
- let logor = Z.logor
- let logxor = Z.logxor
-
- let le a b = Z.compare a b <= 0
- let ge a b = Z.compare a b >= 0
- let lt a b = Z.compare a b < 0
- let gt a b = Z.compare a b > 0
-
-
- let of_int = Z.of_int
-
- let of_int64 = Z.of_int64
- let of_int32 = Z.of_int32
-
- (* Return the same exceptions as [Big_int] *)
- let to_int = Big_int_Z.int_of_big_int
- let to_int64 = Big_int_Z.int64_of_big_int
- let to_int32 = Big_int_Z.int32_of_big_int
-
- let of_string s =
- try Z.of_string s
- with Invalid_argument _ ->
- (* We intentionally do NOT specify a string in the .mli, as Big_int
- raises multiple [Failure _] exceptions *)
- failwith "Integer.of_string"
-
- let max_int64 = of_int64 Int64.max_int
- let min_int64 = of_int64 Int64.min_int
-
- let to_string = Z.to_string
- let to_float = Z.to_float
- let of_float z =
- try Z.of_float z
- with Z.Overflow -> raise Too_big
-
- let bdigits = [|
- "0000" ; (* 0 *)
- "0001" ; (* 1 *)
- "0010" ; (* 2 *)
- "0011" ; (* 3 *)
- "0100" ; (* 4 *)
- "0101" ; (* 5 *)
- "0110" ; (* 6 *)
- "0111" ; (* 7 *)
- "1000" ; (* 8 *)
- "1001" ; (* 9 *)
- "1010" ; (* 10 *)
- "1011" ; (* 11 *)
- "1100" ; (* 12 *)
- "1101" ; (* 13 *)
- "1110" ; (* 14 *)
- "1111" ; (* 15 *)
- |]
-
- let pp_bin_pos fmt r = Format.pp_print_string fmt bdigits.(r)
- let pp_bin_neg fmt r = Format.pp_print_string fmt bdigits.(15-r)
-
- let pp_hex_pos fmt r = Format.fprintf fmt "%04X" r
- let pp_hex_neg fmt r = Format.fprintf fmt "%04X" (0xFFFF-r)
-
- let bmask_bin = Z.of_int 0xF (* 4 bits mask *)
- let bmask_hex = Z.of_int 0xFFFF (* 64 bits mask *)
-
- type digits = {
- nbits : int ; (* max number of bits *)
- bsize : int ; (* bits in each bloc *)
- bmask : Z.t ; (* block mask, must be (1 << bsize) - 1 *)
- sep : string ;
- pp : Format.formatter -> int -> unit ; (* print one block *)
- }
-
- let rec pp_digits d fmt n v =
- if gt v zero || n < d.nbits then
- begin
- let r = Z.to_int (Z.logand v d.bmask) in
- let k = d.bsize in
- pp_digits d fmt (n + k) (Z.shift_right_trunc v k) ;
- if gt v d.bmask || (n + k) < d.nbits
- then Format.pp_print_string fmt d.sep ;
- d.pp fmt r ;
- end
-
- let pp_bin ?(nbits=1) ?(sep="") fmt v =
- let nbits = if nbits <= 0 then 1 else nbits in
- if le zero v then
- ( Format.pp_print_string fmt "0b" ;
- pp_digits { nbits ; sep ; bsize=4 ;
- bmask = bmask_bin ; pp = pp_bin_pos } fmt 0 v )
- else
- ( Format.pp_print_string fmt "1b" ;
- pp_digits { nbits ; sep ; bsize=4 ;
- bmask = bmask_bin ; pp = pp_bin_neg } fmt 0 (Z.lognot v) )
+let power_int_positive_int = Big_int_Z.power_int_positive_int
- let pp_hex ?(nbits=1) ?(sep="") fmt v =
- let nbits = if nbits <= 0 then 1 else nbits in
- if le zero v then
- ( Format.pp_print_string fmt "0x" ;
- pp_digits { nbits ; sep ; bsize=16 ;
- bmask = bmask_hex ; pp = pp_hex_pos } fmt 0 v )
+let popcount = Z.popcount
+let zero = Z.zero
+let one = Z.one
+let minus_one = Z.minus_one
+let two = Z.of_int 2
+let four = Z.of_int 4
+let eight = Z.of_int 8
+let sixteen = Z.of_int 16
+let thirtytwo = Z.of_int 32
+let onethousand = Z.of_int 1000
+let billion_one = Z.of_int 1_000_000_001
+let two_power_32 = two_power_of_int 32
+let two_power_60 = two_power_of_int 60
+let two_power_64 = two_power_of_int 64
+
+let is_zero v = Z.equal v Z.zero
+
+let add = Z.add
+let sub = Z.sub
+let succ = Z.succ
+let pred = Z.pred
+let neg = Z.neg
+
+let mul = Z.mul
+
+let e_div = Z.ediv
+let e_rem = Z.erem
+let e_div_rem = Z.ediv_rem
+
+let c_div = Z.div
+let c_rem = Z.rem
+let c_div_rem = Z.div_rem
+
+let abs = Z.abs
+
+let hash = Z.hash
+
+let shift_left x y = Z.shift_left x (Z.to_int y)
+let shift_right x y = Z.shift_right x (Z.to_int y)
+let shift_right_logical x y = (* no meaning for negative value of x *)
+ if (Z.lt x Z.zero)
+ then raise (Invalid_argument "Integer.shift_right_logical")
+ else Z.shift_right x (Z.to_int y)
+
+let logand = Z.logand
+let lognot = Z.lognot
+let logor = Z.logor
+let logxor = Z.logxor
+
+let le a b = Z.compare a b <= 0
+let ge a b = Z.compare a b >= 0
+let lt a b = Z.compare a b < 0
+let gt a b = Z.compare a b > 0
+
+let of_int = Z.of_int
+let of_int64 = Z.of_int64
+let of_int32 = Z.of_int32
+
+let to_int = Z.to_int
+let to_int64 = Z.to_int64
+let to_int32 = Z.to_int32
+
+let of_string = Z.of_string
+let to_string = Z.to_string
+
+let of_float = Z.of_float
+let to_float = Z.to_float
+let max_int64 = of_int64 Int64.max_int
+let min_int64 = of_int64 Int64.min_int
+
+
+let bdigits = [|
+ "0000" ; (* 0 *)
+ "0001" ; (* 1 *)
+ "0010" ; (* 2 *)
+ "0011" ; (* 3 *)
+ "0100" ; (* 4 *)
+ "0101" ; (* 5 *)
+ "0110" ; (* 6 *)
+ "0111" ; (* 7 *)
+ "1000" ; (* 8 *)
+ "1001" ; (* 9 *)
+ "1010" ; (* 10 *)
+ "1011" ; (* 11 *)
+ "1100" ; (* 12 *)
+ "1101" ; (* 13 *)
+ "1110" ; (* 14 *)
+ "1111" ; (* 15 *)
+|]
+
+let pp_bin_pos fmt r = Format.pp_print_string fmt bdigits.(r)
+let pp_bin_neg fmt r = Format.pp_print_string fmt bdigits.(15-r)
+
+let pp_hex_pos fmt r = Format.fprintf fmt "%04X" r
+let pp_hex_neg fmt r = Format.fprintf fmt "%04X" (0xFFFF-r)
+
+let bmask_bin = Z.of_int 0xF (* 4 bits mask *)
+let bmask_hex = Z.of_int 0xFFFF (* 64 bits mask *)
+
+type digits = {
+ nbits : int ; (* max number of bits *)
+ bsize : int ; (* bits in each bloc *)
+ bmask : Z.t ; (* block mask, must be (1 << bsize) - 1 *)
+ sep : string ;
+ pp : Format.formatter -> int -> unit ; (* print one block *)
+}
+
+let rec pp_digits d fmt n v =
+ if gt v zero || n < d.nbits then
+ begin
+ let r = Z.to_int (Z.logand v d.bmask) in
+ let k = d.bsize in
+ pp_digits d fmt (n + k) (Z.shift_right_trunc v k) ;
+ if gt v d.bmask || (n + k) < d.nbits
+ then Format.pp_print_string fmt d.sep ;
+ d.pp fmt r ;
+ end
+
+let pp_bin ?(nbits=1) ?(sep="") fmt v =
+ let nbits = if nbits <= 0 then 1 else nbits in
+ if le zero v then
+ ( Format.pp_print_string fmt "0b" ;
+ pp_digits { nbits ; sep ; bsize=4 ;
+ bmask = bmask_bin ; pp = pp_bin_pos } fmt 0 v )
+ else
+ ( Format.pp_print_string fmt "1b" ;
+ pp_digits { nbits ; sep ; bsize=4 ;
+ bmask = bmask_bin ; pp = pp_bin_neg } fmt 0 (Z.lognot v) )
+
+let pp_hex ?(nbits=1) ?(sep="") fmt v =
+ let nbits = if nbits <= 0 then 1 else nbits in
+ if le zero v then
+ ( Format.pp_print_string fmt "0x" ;
+ pp_digits { nbits ; sep ; bsize=16 ;
+ bmask = bmask_hex ; pp = pp_hex_pos } fmt 0 v )
+
+ else
+ ( Format.pp_print_string fmt "1x" ;
+ pp_digits { nbits ; sep ; bsize=16 ;
+ bmask = bmask_hex ; pp = pp_hex_neg } fmt 0 (Z.lognot v) )
+let pretty ?(hexa=false) fmt v =
+ let rec aux v =
+ if gt v two_power_60 then
+ let quo, rem = Z.ediv_rem v two_power_60 in
+ aux quo;
+ Format.fprintf fmt "%015LX" (to_int64 rem)
else
- ( Format.pp_print_string fmt "1x" ;
- pp_digits { nbits ; sep ; bsize=16 ;
- bmask = bmask_hex ; pp = pp_hex_neg } fmt 0 (Z.lognot v) )
-
- let pretty ?(hexa=false) fmt v =
- let rec aux v =
- if gt v two_power_60 then
- let quo, rem = Z.ediv_rem v two_power_60 in
- aux quo;
- Format.fprintf fmt "%015LX" (to_int64 rem)
- else
- Format.fprintf fmt "%LX" (to_int64 v)
- in
- if hexa then
- if equal v zero then Format.pp_print_string fmt "0"
- else if gt v zero then (Format.pp_print_string fmt "0x"; aux v)
- else (Format.pp_print_string fmt "-0x"; aux (Z.neg v))
- else
- Format.pp_print_string fmt (to_string v)
-
- let is_one v = equal one v
- let pos_div = div
-
- let pos_rem = rem
- let native_div = div
- let divexact = Z.divexact
- let div_rem = Z.div_rem
-
- let _c_div u v =
- let bad_div = div u v in
- if (lt u zero) && not (is_zero (rem u v))
- then
- if lt v zero
- then pred bad_div
- else succ bad_div
- else bad_div
-
- let _c_div u v =
- let res = _c_div u v in
- let res2 = Z.div u v in
- if not (equal res res2) then
- failwith (Printf.sprintf "division of %a %a c_div %a div %a"
- Z.sprint u
- Z.sprint v
- Z.sprint res
- Z.sprint res2)
- else res2
-
- let c_div = Z.div
-
- let _c_rem u v =
- sub u (mul v (c_div u v))
-
- let _c_rem u v =
- let res = _c_rem u v in
- let res2 = Z.rem u v in
- if not (equal res res2) then
- failwith (Printf.sprintf "division of %a %a c_rem %a rem %a"
- Z.sprint u
- Z.sprint v
- Z.sprint res
- Z.sprint res2)
- else res2
-
- let c_rem = Z.rem
-
- let cast ~size ~signed ~value =
- if (not signed)
- then
- let factor = two_power size in logand value (pred factor)
+ Format.fprintf fmt "%LX" (to_int64 v)
+ in
+ if hexa then
+ if equal v zero then Format.pp_print_string fmt "0"
+ else if gt v zero then (Format.pp_print_string fmt "0x"; aux v)
+ else (Format.pp_print_string fmt "-0x"; aux (Z.neg v))
+ else
+ Format.pp_print_string fmt (to_string v)
+
+let is_one v = equal one v
+
+let cast ~size ~signed ~value =
+ if (not signed)
+ then
+ let factor = two_power size in logand value (pred factor)
+ else
+ let mask = two_power (sub size one) in
+ let p_mask = pred mask in
+ if equal (logand mask value) zero
+ then logand value p_mask
else
- let mask = two_power (sub size one) in
- let p_mask = pred mask in
- if equal (logand mask value) zero
- then logand value p_mask
- else
- logor (lognot p_mask) value
-
- let length u v = succ (sub v u)
+ logor (lognot p_mask) value
- let extract_bits ~start ~stop v =
- assert (ge start zero && ge stop start);
- (*Format.printf "%a[%a..%a]@\n" pretty v pretty start pretty stop;*)
- let r = Z.extract v (to_int start) (to_int (length start stop)) in
- (*Format.printf "%a[%a..%a]=%a@\n" pretty v pretty start pretty stop pretty r;*)
- r
+let length u v = succ (sub v u)
- let is_even v = is_zero (logand one v)
+let extract_bits ~start ~stop v =
+ assert (ge start zero && ge stop start);
+ (*Format.printf "%a[%a..%a]@\n" pretty v pretty start pretty stop;*)
+ let r = Z.extract v (to_int start) (to_int (length start stop)) in
+ (*Format.printf "%a[%a..%a]=%a@\n" pretty v pretty start pretty stop pretty r;*)
+ r
- let pgcd u v =
- if is_zero v then abs u (* Zarith raises an exception on zero arguments *)
- else if is_zero u then abs v
- else Z.gcd u v
+let is_even v = is_zero (logand one v)
- let ppcm u v =
- if u = zero || v = zero
- then zero
- else Z.lcm u v
+let pgcd u v =
+ if is_zero v then abs u (* Zarith raises an exception on zero arguments *)
+ else if is_zero u then abs v
+ else Z.gcd u v
- let min = Z.min
- let max = Z.max
+let ppcm u v =
+ if u = zero || v = zero
+ then zero
+ else Z.lcm u v
- let round_down_to_zero v modu =
- mul (pos_div v modu) modu
+let min = Z.min
+let max = Z.max
- let round_up_to_r ~min:m ~r ~modu =
- add (add (round_down_to_zero (pred (sub m r)) modu) r) modu
+let round_down_to_zero v modu =
+ mul (e_div v modu) modu
- let round_down_to_r ~max:m ~r ~modu =
- add (round_down_to_zero (sub m r) modu) r
+let round_up_to_r ~min:m ~r ~modu =
+ add (add (round_down_to_zero (pred (sub m r)) modu) r) modu
- let power_int_positive_int = Big_int_Z.power_int_positive_int
+let round_down_to_r ~max:m ~r ~modu =
+ add (round_down_to_zero (sub m r) modu) r
diff --git a/src/libraries/stdlib/integer.mli b/src/libraries/stdlib/integer.mli
index 3ed0f1297471b8c393056437955eec4085c79363..58c641c2c8083165291b3cfd3a446bdee9c77d01 100644
--- a/src/libraries/stdlib/integer.mli
+++ b/src/libraries/stdlib/integer.mli
@@ -20,14 +20,11 @@
(* *)
(**************************************************************************)
-(** Extension of [Big_int] compatible with [Zarith].
+(** Extension of [Big_int] compatible with [Zarith].
@since Nitrogen-20111001 *)
type t = Z.t
-exception Too_big (** Produced by values whose physical representation is too
- costly (e.g. in terms of memory usage). *)
-
val equal : t -> t -> bool
val compare : t -> t -> int
@@ -41,8 +38,14 @@ val sub : t -> t -> t
val mul : t -> t -> t
val shift_left : t -> t -> t
+(** @raise Invalid_argument if second argument (count) is negative *)
+
val shift_right : t -> t -> t
+(** @raise Invalid_argument if second argument (count) is negative *)
+
val shift_right_logical : t -> t -> t
+(** @raise Invalid_argument if any argument is negative *)
+
val logand : t -> t -> t
val logor : t -> t -> t
val logxor : t -> t -> t
@@ -51,27 +54,35 @@ val lognot : t -> t
val min : t -> t -> t
val max : t -> t -> t
-val native_div : t -> t -> t
-val div : t -> t -> t
-(** Euclidean division (that returns a positive rem) *)
-val pos_div : t -> t -> t
-(** Euclidean division. Equivalent to C division if both operands are positive.
+val e_div : t -> t -> t
+(** Euclidean division (that returns a positive rem).
+ Implemented by [Z.ediv]
+
+ Equivalent to C division if both operands are positive.
Equivalent to a floored division if b > 0 (rounds downwards),
otherwise rounds upwards.
- Note: it is possible that pos_div (-a) b <> pos_div a (-b). *)
-val divexact: t -> t -> t
-(** Faster, but produces correct results only when b evenly divides a. *)
+ Note: it is possible that e_div (-a) b <> e_div a (-b).
+*)
+
+val e_rem : t -> t -> t
+(** Remainder of the Euclidean division (always positive).
+ Implemented by [Z.erem] *)
+
+val e_div_rem: t -> t -> (t * t)
+(** [e_div_rem a b] returns [(e_div a b, e_rem a b)].
+ Implemented by [Z.ediv_rem] *)
+
val c_div : t -> t -> t
-(** Truncated division towards 0 (like in C99) *)
+(** Truncated division towards 0 (like in C99).
+ Implemented by [Z.div] *)
-val rem : t -> t -> t
-(** Remainder of the Euclidean division (always positive) *)
val c_rem : t -> t -> t
-(** Remainder of the truncated division towards 0 (like in C99) *)
-val div_rem: t -> t -> (t * t)
-(** [div_rem a b] returns [(pos_div a b, pos_rem a b)] *)
-val pos_rem : t -> t -> t
-(** Remainder of the Euclidean division (always positive) *)
+(** Remainder of the truncated division towards 0 (like in C99).
+ Implemented by [Z.rem] *)
+
+val c_div_rem : t -> t -> t * t
+(** [c_div_rem a b] returns [(c_div a b, c_rem a b)].
+ Implemented by [Z.div_rem] *)
val pgcd : t -> t -> t
(** [pgcd v 0 == pgcd 0 v == abs v]. Result is always positive *)
@@ -79,9 +90,6 @@ val pgcd : t -> t -> t
val ppcm : t -> t -> t
(** [ppcm v 0 == ppcm 0 v == 0]. Result is always positive *)
-val power_int_positive_int: int -> int -> t
-(** Exponentiation *)
-
val cast: size:t -> signed:bool -> value:t -> t
val abs : t -> t
@@ -113,16 +121,13 @@ val length : t -> t -> t (** b - a + 1 *)
val of_int : int -> t
val of_int64 : Int64.t -> t
val of_int32 : Int32.t -> t
-val to_int64 : t -> int64
-val to_int32 : t -> int32
-val to_int : t -> int
-(** @raise Failure if the argument does not fit in an OCaml int *)
+val to_int : t -> int (** @raise Z.Overflow if too big *)
+val to_int64 : t -> int64 (** @raise Z.Overflow if too big *)
+val to_int32 : t -> int32 (** @raise Z.Overflow if too big *)
val to_float : t -> float
val of_float : float -> t
-(** Converts from a floating-point value. The value is truncated.
- Raises [Overflow] on infinity and NaN arguments. *)
val round_up_to_r : min:t -> r:t -> modu:t -> t
(** [round_up_to_r m r modu] is the smallest number [n] such that
@@ -133,20 +138,22 @@ val round_down_to_r : max:t -> r:t -> modu:t -> t
[n]<=[m] and [n] = [r] modulo [modu] *)
val two_power : t -> t
-(** [two_power x] computes 2^x. Can raise [Too_big]. *)
+(** Computes [2^n]
+ @raise Z.Overflow for exponents greater than 1024 *)
+
val two_power_of_int : int -> t
-(** Similar to [two_power x], but x is an OCaml int. *)
+(** Computes [2^n] *)
-val extract_bits : start:t -> stop:t -> t -> t
+val power_int_positive_int: int -> int -> t
+(** Exponentiation *)
+val extract_bits : start:t -> stop:t -> t -> t
+val popcount: t -> int
val hash : t -> int
-val of_string : string -> t
-(** @raise Failure _ when the string cannot be parsed. *)
-
val to_string : t -> string
-
-val popcount: t -> int
+val of_string : string -> t
+(** @raise Invalid_argument when the string cannot be parsed. *)
val pretty : ?hexa:bool -> t Pretty_utils.formatter
@@ -154,16 +161,16 @@ val pp_bin : ?nbits:int -> ?sep:string -> t Pretty_utils.formatter
(** Print binary format. Digits are output by blocs of 4 bits
separated by [~sep] with at least [~nbits] total bits. If [nbits] is
non positive, it will be ignored.
-
- Positive values are prefixed with ["0b"] and negative values
+
+ Positive values are prefixed with ["0b"] and negative values
are printed as their 2-complement ([lnot]) with prefix ["1b"]. *)
val pp_hex : ?nbits:int -> ?sep:string -> t Pretty_utils.formatter
-(** Print hexadecimal format. Digits are output by blocs of 16 bits
- (4 hex digits) separated by [~sep] with at least [~nbits] total bits.
+(** Print hexadecimal format. Digits are output by blocs of 16 bits
+ (4 hex digits) separated by [~sep] with at least [~nbits] total bits.
If [nbits] is non positive, it will be ignored.
-
- Positive values are preffixed with ["0x"] and negative values
+
+ Positive values are preffixed with ["0x"] and negative values
are printed as their 2-complement ([lnot]) with prefix ["1x"]. *)
(*
diff --git a/src/libraries/utils/floating_point.ml b/src/libraries/utils/floating_point.ml
index c8361ffa26a50e71ea52282b8ee9653872c2202e..bc487fe40a9b9459227ff24ded4103019849720f 100644
--- a/src/libraries/utils/floating_point.ml
+++ b/src/libraries/utils/floating_point.ml
@@ -102,10 +102,7 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
*)
if exp > max_exp - man_size then inf ~man_size ~max_exp
else
- let man = Integer.native_div num den in
- let rem =
- Integer.sub num (Integer.mul den man)
- in
+ let man,rem = Integer.e_div_rem num den in
let rem2 = (* twice the remainder *)
Integer.shift_left rem Integer.one
in
diff --git a/src/libraries/utils/rich_text.ml b/src/libraries/utils/rich_text.ml
index b29ffe37e52a7ac8d08f4291ed80042613f362c9..3a15771b965c85bb62c45878e0e82a8d9cdfc76c 100644
--- a/src/libraries/utils/rich_text.ml
+++ b/src/libraries/utils/rich_text.ml
@@ -162,7 +162,7 @@ let truncate_text buffer size =
(* All text added shall go through this function *)
let append buffer s k n =
- FCBuffer.add_substring buffer.content s k n ;
+ FCBuffer.add_substring buffer.content s k n ;
if FCBuffer.length buffer.content > tgr_buffer then
truncate_text buffer max_buffer
@@ -210,11 +210,11 @@ let create ?indent ?margin () =
end ;
let open Format in
pp_set_formatter_tag_functions fmt {
- print_open_tag = push_tag buffer ;
- print_close_tag = pop_tag buffer ;
- mark_open_tag = no_mark ;
- mark_close_tag = no_mark ;
- } ;
+ print_open_tag = push_tag buffer ;
+ print_close_tag = pop_tag buffer ;
+ mark_open_tag = no_mark ;
+ mark_close_tag = no_mark ;
+ } ;
pp_set_print_tags fmt true ;
pp_set_mark_tags fmt false ;
buffer
@@ -244,4 +244,3 @@ let bprintf buffer text = Format.fprintf buffer.formatter text
let kprintf kjob buffer text = Format.kfprintf kjob buffer.formatter text
(* -------------------------------------------------------------------------- *)
-
diff --git a/src/libraries/utils/rich_text.mli b/src/libraries/utils/rich_text.mli
index 9e84fc4b9960e6ad0d3ca848c0e9dd3f7cc54001..415d3e3ef32a1a708b89b5606c1104812786e13f 100644
--- a/src/libraries/utils/rich_text.mli
+++ b/src/libraries/utils/rich_text.mli
@@ -47,8 +47,8 @@ val pretty : ?vbox:int -> Format.formatter -> message -> unit
(** Pretty-print the message onto the given formatter, with the tags.
The original message has been {i already} laidout with respect to
horizontal and vertical boxes, and this layout will be output as-it-is
- into the formatter.
-
+ into the formatter.
+
Here, you have two different strategies to render the message properly.
If [~vbox] is specified, a vertical box is opened around the message,
and newlines are emitted with a ["@\n"] and the given indentation.
@@ -61,16 +61,16 @@ val pretty : ?vbox:int -> Format.formatter -> message -> unit
(* -------------------------------------------------------------------------- *)
(** Buffer for creating messages.
-
+
The buffer grows on demand, but is protected against huge mesages.
Maximal size is around 2 billions ASCII characters, which sould be enough
to store more than 25kloc source text. *)
type buffer
-(** Create a buffer.
+(** Create a buffer.
- The right-margin is set to [~margin] and
- maximum indentation to [~indent].
+ The right-margin is set to [~margin] and
+ maximum indentation to [~indent].
Default values are those of [Format.make_formatter], which are
[~indent:68] and [~margin:78] in OCaml 4.05.
*)
diff --git a/src/plugins/constant_propagation/api.ml b/src/plugins/constant_propagation/api.ml
index 46fcc0277d1924079f5fb58beb5961283859f7e4..58c9aa199a689ab05b50958687f1d4504cd33ed1 100644
--- a/src/plugins/constant_propagation/api.ml
+++ b/src/plugins/constant_propagation/api.ml
@@ -181,9 +181,8 @@ class propagate project fnames ~cast_intro = object(self)
in
array, Int_Base.project size
in
- array,
- (Integer.pos_div offset sizeof_pointed),
- (Integer.pos_rem offset sizeof_pointed)
+ let div,rem = Integer.e_div_rem offset sizeof_pointed in
+ array,div,rem
in
let expr' =
if array then
diff --git a/src/plugins/gui/design.ml b/src/plugins/gui/design.ml
index eb1636c296c32fb083ff6359c212595fcdf6410c..1e8d0334f1ee83607308381926fe031e1cbf4aaa 100644
--- a/src/plugins/gui/design.ml
+++ b/src/plugins/gui/design.ml
@@ -271,8 +271,9 @@ let filetree_selector
end
let pretty_predicate_status fmt p =
- let s = Property_status.get p in
- Format.fprintf fmt "Status: %a@." Property_status.pretty s
+ if Property.has_status p then
+ let s = Property_status.get p in
+ Format.fprintf fmt "Status: %a@." Property_status.pretty s
(* This is called when a localizable is selected in the pretty-printed source
buffer *)
@@ -419,6 +420,7 @@ let to_do_on_select
in
if button = 1 then begin
match selected with
+ | PStmtStart _ -> ()
| PStmt (kf, stmt) ->
current_statement_msg (Some kf) (Kstmt stmt);
print_code_annotations main_ui kf stmt;
@@ -445,7 +447,7 @@ let to_do_on_select
main_ui#pretty_information "This is a requires clause.@.%a@."
pretty_predicate_status ip;
main_ui#view_original (Property.location ip)
- | PIP (Property.IPExtended(_,(_,name,_,_)) as ip) ->
+ | PIP (Property.IPExtended(_,(_,name,_,_,_)) as ip) ->
main_ui#pretty_information "This clause is a %s extension.@.%a@."
name
pretty_predicate_status ip;
@@ -840,17 +842,16 @@ class main_window () : main_window_extension_points =
width, if final_h then height else new_height
in
let main_window =
- GWindow.window
+ Gtk_compat.window
?icon:framac_icon
~title:"Frama-C"
- ~width
- ~height
~position:`CENTER
~resizable:true
~show:false
()
in
let () = main_window#set_default_size ~width ~height in
+ let () = main_window#set_geometry_hints ~min_size:(1,1) main_window#coerce in
let watch_cursor = Gdk.Cursor.create `WATCH in
let arrow_cursor = Gdk.Cursor.create `ARROW in
@@ -1175,7 +1176,7 @@ class main_window () : main_window_extension_points =
varinfo or a global for [loc], then scroll to [loc]. *)
method scroll loc =
Gui_parameters.debug ~dkey:dkey_scroll
- "main_ui: scroll: localizable %a" Pretty_source.Localizable.pretty loc;
+ "main_ui: scroll: localizable %a" Printer_tag.Localizable.pretty loc;
(* Used to avoid having two different history events, one created
by [select_global], the other by [scroll] *)
let history = History.on_current_history () in
diff --git a/src/plugins/gui/filetree.ml b/src/plugins/gui/filetree.ml
index 025ade684ae402129dfc5500c43f66fafa9a3a0c..b43c4f593db11d9679434a52a86a084ec7843434 100644
--- a/src/plugins/gui/filetree.ml
+++ b/src/plugins/gui/filetree.ml
@@ -325,7 +325,7 @@ module MYTREE = struct
| Dtype_annot (li, _) -> Some (global_name li.l_var_info.lv_name)
| Dmodel_annot (mf, _) -> Some (global_name mf.mi_name)
| Dcustom_annot _ -> Some "custom clause"
- | Dextended ((_,name,_,_),_,_) -> Some ("ACSL extension " ^ name)
+ | Dextended ((_,name,_,_,_),_,_) -> Some ("ACSL extension " ^ name)
let make_list_globals hide sort_order globs =
(* Association list binding names to globals. *)
diff --git a/src/plugins/gui/gtk_compat.2.ml b/src/plugins/gui/gtk_compat.2.ml
index 945c310aa97880c02aa80cec3c2bd9b35f1da11b..4bc1c0d776d4f419371dafbebfbc2c4689aaddcb 100644
--- a/src/plugins/gui/gtk_compat.2.ml
+++ b/src/plugins/gui/gtk_compat.2.ml
@@ -20,5 +20,55 @@
(* *)
(**************************************************************************)
+module Pango = struct
+ open Wutil_once
+
+ let small_font =
+ once (fun f ->
+ let f = Pango.Font.copy f in
+ let s = Pango.Font.get_size f in
+ Pango.Font.set_size f (s-2) ; f)
+
+ let bold_font =
+ once (fun f ->
+ let f = Pango.Font.copy f in
+ Pango.Font.set_weight f `BOLD ; f)
+
+ let modify_font phi widget =
+ widget#misc#modify_font (phi widget#misc#pango_context#font_description)
+
+ let set_small_font w = modify_font small_font w
+ let set_bold_font w = modify_font bold_font w
+end
+
let get_toolbar_index (toolbar:GButton.toolbar) (item:GButton.tool_item) =
toolbar#get_item_index item
+
+let window
+ ?(kind:Gtk.Tags.window_type option)
+ ?(title:string option)
+ ?(decorated:bool option)
+ ?(deletable:bool option)
+ ?(focus_on_map:bool option)
+ ?(icon:GdkPixbuf.pixbuf option)
+ ?(icon_name:string option)
+ ?(modal:bool option)
+ ?(position:Gtk.Tags.window_position option)
+ ?(resizable:bool option)
+ ?(screen:Gdk.screen option)
+ ?(type_hint:Gdk.Tags.window_type_hint option)
+ ?(urgency_hint:bool option)
+ ?(wmclass:(string * string) option)
+ ?(border_width:int option)
+ ?(width:int option)
+ ?(height:int option)
+ ?(show:bool option)
+ ()
+ =
+ let allow_shrink = resizable in
+ let allow_grow = resizable in
+ ignore wmclass;
+ GWindow.window
+ ?kind ?title ?decorated ?deletable ?focus_on_map ?icon ?icon_name
+ ?modal ?position ?resizable ?allow_grow ?allow_shrink ?screen
+ ?type_hint ?urgency_hint ?border_width ?width ?height ?show ()
diff --git a/src/plugins/gui/gtk_compat.3.ml b/src/plugins/gui/gtk_compat.3.ml
index b29fa610143511694a30dbd7a1358e153bbafeb6..fecbc6508665e8660499df188b2e5a2065a3c046 100644
--- a/src/plugins/gui/gtk_compat.3.ml
+++ b/src/plugins/gui/gtk_compat.3.ml
@@ -20,4 +20,28 @@
(* *)
(**************************************************************************)
+module Pango = struct
+ open Wutil_once
+
+ let small_font =
+ once (fun (f: GPango.font_description) ->
+ let f = f#copy in
+ let size = f#size - 2 in
+ f#modify ~size (); f)
+
+ let bold_font =
+ once (fun (f: GPango.font_description) ->
+ let f = f#copy in
+ let weight = `BOLD in
+ f#modify ~weight (); f)
+
+ let modify_font phi (widget: #GObj.widget) =
+ widget#misc#modify_font (phi widget#misc#pango_context#font_description)
+
+ let set_small_font w = modify_font small_font w
+ let set_bold_font w = modify_font bold_font w
+end
+
let get_toolbar_index toolbar item = toolbar#get_item_index item#as_tool_item
+
+let window = GWindow.window
diff --git a/src/plugins/gui/gtk_compat.mli b/src/plugins/gui/gtk_compat.mli
index 61f6af64a07b6d382d0fb836b8f19b96049280dc..16f554231bdfd307259bf30aa0abf484cae3e769 100644
--- a/src/plugins/gui/gtk_compat.mli
+++ b/src/plugins/gui/gtk_compat.mli
@@ -20,4 +20,27 @@
(* *)
(**************************************************************************)
+module Pango : sig
+ val set_small_font : #GObj.widget -> unit (** makes the font smaller. *)
+ val set_bold_font : #GObj.widget -> unit (** makes the font bold. *)
+end
+
val get_toolbar_index: GButton.toolbar -> GButton.tool_item -> int
+
+val window:
+ ?kind:Gtk.Tags.window_type ->
+ ?title:string ->
+ ?decorated:bool ->
+ ?deletable:bool ->
+ ?focus_on_map:bool ->
+ ?icon:GdkPixbuf.pixbuf ->
+ ?icon_name:string ->
+ ?modal:bool ->
+ ?position:Gtk.Tags.window_position ->
+ ?resizable:bool ->
+ ?screen:Gdk.screen ->
+ ?type_hint:Gdk.Tags.window_type_hint ->
+ ?urgency_hint:bool ->
+ ?wmclass:(string * string) ->
+ ?border_width:int ->
+ ?width:int -> ?height:int -> ?show:bool -> unit -> GWindow.window
diff --git a/src/plugins/gui/history.ml b/src/plugins/gui/history.ml
index d3b93d134ab5157d0d5401afed50607caeb28f57..8522852a0032abd09a52d04c1d6a15b85feb0fcb 100644
--- a/src/plugins/gui/history.ml
+++ b/src/plugins/gui/history.ml
@@ -37,7 +37,7 @@ module HistoryElt = struct
let equal e1 e2 = match e1, e2 with
| Global g1, Global g2 -> Cil_datatype.Global.equal g1 g2
| Localizable l1, Localizable l2 ->
- Pretty_source.Localizable.equal l1 l2
+ Printer_tag.Localizable.equal l1 l2
| (Global _ | Localizable _), __ -> false
end)
(* Identify two elements that belong to the same function *)
@@ -254,9 +254,9 @@ let translate_history_elt old_helt =
match old_helt with
| Global old_g -> global_Global old_g
| Localizable (PGlobal old_g) -> global_Global old_g
- | Localizable(PVDecl(Some kf,_,_)) ->
- global_Global (kf_to_global kf)
- | Localizable ( PStmt(kf,_) | PLval(Some kf,_,_) | PExp(Some kf,_,_)
+ | Localizable(PVDecl(Some kf,_,_)) -> global_Global (kf_to_global kf)
+ | Localizable ( PStmt(kf,_) | PStmtStart(kf,_) |
+ PLval(Some kf,_,_) | PExp(Some kf,_,_)
| PTermLval(Some kf,_,_,_) as loc) ->
begin match global (kf_to_global kf) with
| None ->
diff --git a/src/plugins/gui/pretty_source.ml b/src/plugins/gui/pretty_source.ml
index ec69447e74d6e46727fb501cde80ce7bf861bd82..5a1f810e04f26cce0e71f89a660a2a358325d27e 100644
--- a/src/plugins/gui/pretty_source.ml
+++ b/src/plugins/gui/pretty_source.ml
@@ -20,100 +20,32 @@
(* *)
(**************************************************************************)
-open Format
open Cil_types
open Gtk_helper
open Cil_datatype
+open Printer_tag
-let dkey = Gui_parameters.register_category "pretty-source"
-
-(** The kind of object that can be selected in the source viewer *)
-type localizable =
+type localizable = Printer_tag.localizable =
| PStmt of (kernel_function * stmt)
+ | PStmtStart of (kernel_function * stmt)
| PLval of (kernel_function option * kinstr * lval)
| PExp of (kernel_function option * kinstr * exp)
| PTermLval of (kernel_function option * kinstr * Property.t * term_lval)
| PVDecl of (kernel_function option * kinstr * varinfo)
- | PGlobal of global
+ (** Declaration and definition of variables and function. Check the type
+ of the varinfo to distinguish between the various possibilities.
+ If the varinfo is a global or a local, the kernel_function is the
+ one in which the variable is declared. The [kinstr] argument is given
+ for local variables with an explicit initializer. *)
+ | PGlobal of global (** all globals but variable declarations and function
+ definitions. *)
| PIP of Property.t
-module Localizable =
- Datatype.Make
- (struct
- include Datatype.Undefined
- type t = localizable
- let name = "Pretty_source.Localizable"
- let reprs = List.map (fun g -> PGlobal g) Global.reprs
- let equal l1 l2 = match l1,l2 with
- | PStmt (_,ki1), PStmt (_,ki2) -> ki1.sid = ki2.sid
- | PLval (_,ki1,lv1), PLval (_,ki2,lv2) ->
- Kinstr.equal ki1 ki2 && lv1 == lv2
- | PTermLval (_,ki1,pi1,lv1), PTermLval (_,ki2,pi2,lv2) ->
- Kinstr.equal ki1 ki2 && Property.equal pi1 pi2 &&
- Logic_utils.is_same_tlval lv1 lv2
- (* [JS 2008/01/21] term_lval are not shared: cannot use == *)
- | PVDecl (_,_,v1), PVDecl (_,_,v2) -> Varinfo.equal v1 v2
- | PExp (_,_,e1), PExp(_,_,e2) -> Cil_datatype.Exp.equal e1 e2
- | PIP ip1, PIP ip2 -> Property.equal ip1 ip2
- | PGlobal g1, PGlobal g2 -> Cil_datatype.Global.equal g1 g2
- | (PStmt _ | PLval _ | PExp _ | PTermLval _ | PVDecl _
- | PIP _ | PGlobal _), _
- -> false
- let mem_project = Datatype.never_any_project
- let pp_ki_loc fmt ki =
- match ki with
- | Kglobal -> (* no location, print 'global' *)
- Format.fprintf fmt "global"
- | Kstmt st ->
- Format.fprintf fmt "%a" Cil_datatype.Location.pretty (Stmt.loc st)
- let pretty fmt = function
- | PStmt (_, s) -> Format.fprintf fmt "LocalizableStmt %d (%a)"
- s.sid Printer.pp_location (Cil_datatype.Stmt.loc s)
- | PLval (_, ki, lv) ->
- Format.fprintf fmt "LocalizableLval %a (%a)"
- Printer.pp_lval lv pp_ki_loc ki
- | PExp (_, ki, lv) ->
- Format.fprintf fmt "LocalizableExp %a (%a)"
- Printer.pp_exp lv pp_ki_loc ki
- | PTermLval (_, ki, _pi, tlv) ->
- Format.fprintf fmt "LocalizableTermLval %a (%a)"
- Printer.pp_term_lval tlv pp_ki_loc ki
- | PVDecl (_, _, vi) ->
- Format.fprintf fmt "LocalizableVDecl %a" Printer.pp_varinfo vi
- | PGlobal g ->
- Format.fprintf fmt "LocalizableGlobal %a" Printer.pp_global g
- | PIP ip ->
- Format.fprintf fmt "LocalizableIP %a" Description.pp_property ip
- end)
-
-let kf_of_localizable loc = match loc with
- | PLval (kf_opt, _, _)
- | PExp (kf_opt,_,_)
- | PTermLval(kf_opt, _,_,_)
- | PVDecl (kf_opt, _, _) -> kf_opt
- | PStmt (kf, _) -> Some kf
- | PIP ip -> Property.get_kf ip
- | PGlobal (GFun ({svar = vi}, _)) -> Some (Globals.Functions.get vi)
- | PGlobal _ -> None
-
-let ki_of_localizable loc = match loc with
- | PLval (_, ki, _)
- | PExp (_, ki, _)
- | PTermLval(_, ki,_,_)
- | PVDecl (_, ki, _) -> ki
- | PStmt (_, st) -> Kstmt st
- | PIP ip -> Property.get_kinstr ip
- | PGlobal _ -> Kglobal
-
-let varinfo_of_localizable loc =
- match kf_of_localizable loc with
- | Some kf -> Some (Kernel_function.get_vi kf)
- | None ->
- match loc with
- | PGlobal (GVar (vi, _, _) | GVarDecl (vi, _)
- | GFunDecl (_, vi, _) | GFun ({svar = vi }, _)) -> Some vi
- | _ -> None
+let dkey = Gui_parameters.register_category "pretty-source"
+let kf_of_localizable = Printer_tag.kf_of_localizable
+let ki_of_localizable = Printer_tag.ki_of_localizable
+let varinfo_of_localizable = Printer_tag.varinfo_of_localizable
module Locs:sig
type state
@@ -126,7 +58,6 @@ module Locs:sig
val set_hilite : state -> (unit -> unit) -> unit
val add_finalizer: state -> (unit -> unit) -> unit
val size : state -> int
- val add_stmt_start: state -> int (* sid *) -> int (* offset *) -> unit
val stmt_start: state -> stmt -> int
end
=
@@ -169,12 +100,12 @@ struct
For example: 'loop assigns x;' will be indexed as an assigns
and not as a code annotation.
*)
- let add state loc v =
- if not (Hashtbl.mem state.table loc) then
- Hashtbl.add state.table loc v
-
- let add_stmt_start state sid start =
- Datatype.Int.Hashtbl.add state.stmt_start sid start
+ let add state range = function
+ | Printer_tag.PStmtStart(_,st) ->
+ Datatype.Int.Hashtbl.add state.stmt_start st.sid (fst range)
+ | localizable ->
+ if not (Hashtbl.mem state.table range) then
+ Hashtbl.add state.table range localizable
let stmt_start state s =
Datatype.Int.Hashtbl.find state.stmt_start s.sid
@@ -274,383 +205,31 @@ let fold_preconds_at_callsite stmt =
let are_preconds_unfolded stmt =
Cil_datatype.Stmt.Hashtbl.mem unfold_preconds stmt
+module Tag =
+struct
-module Tag = struct
- exception Wrong_decoder
- let make_modem charcode =
- let h = Hashtbl.create 17 in
- let current = ref 0 in
- (function lv ->
- incr current;
- Hashtbl.add h !current lv;
- sprintf "guitag:%c%x" charcode !current),
- (function code ->
- Scanf.sscanf code "guitag:%c%x"
- (fun c code ->
- if c=charcode then
- try Hashtbl.find h code with Not_found -> assert false
- else raise Wrong_decoder))
-
- let encode_stmt,decode_stmt = make_modem 's'
- let encode_lval,decode_lval = make_modem 'l'
- let encode_exp,decode_exp = make_modem 'e'
- let encode_termlval,decode_termlval = make_modem 't'
- let encode_vdecl,decode_vdecl = make_modem 'd'
- let encode_global,decode_global = make_modem 'g'
- let encode_ip,decode_ip = make_modem 'i'
-
- let create = function
- | PStmt sid -> encode_stmt sid
- | PLval lval -> encode_lval lval
- | PExp e -> encode_exp e
- | PTermLval lval -> encode_termlval lval
- | PVDecl vi -> encode_vdecl vi
- | PGlobal g -> encode_global g
- | PIP ip -> encode_ip ip
+ let hashtbl = Hashtbl.create 0
+ let current = ref 0
+ let charcode = function
+ | PStmt _ -> 's'
+ | PStmtStart _ -> 'k'
+ | PLval _ -> 'l'
+ | PExp _ -> 'e'
+ | PTermLval _ -> 't'
+ | PVDecl _ -> 'd'
+ | PGlobal _ -> 'g'
+ | PIP _ -> 'i'
+
+ let create loc =
+ incr current ;
+ let tag = Printf.sprintf "guitag:%c%x" (charcode loc) !current in
+ Hashtbl.replace hashtbl tag loc ; tag
+
+ let get = Hashtbl.find hashtbl
- let get s =
- try
- PExp (decode_exp s)
- with Wrong_decoder -> try
- PStmt (decode_stmt s)
- with Wrong_decoder -> try
- PLval (decode_lval s)
- with Wrong_decoder -> try
- PTermLval (decode_termlval s)
- with Wrong_decoder -> try
- PVDecl (decode_vdecl s)
- with Wrong_decoder -> try
- PGlobal (decode_global s)
- with Wrong_decoder -> try
- PIP (decode_ip s)
- with Wrong_decoder ->
- assert false
end
-(* We delay the creation of the class to execution time, so that all
- pretty-printer extensions get properly registered (as we want to inherit
- from them). The only known solution is to use a functor *)
-module TagPrinterClassDeferred (X: Printer.PrinterClass) = struct
-
- class tagPrinterClass : Printer.extensible_printer = object(self)
-
- inherit X.printer as super
-
- val mutable current_property = None
-
- method private current_kinstr =
- match self#current_stmt with
- | None -> Kglobal
- | Some st -> Kstmt st
-
- method private current_sid =
- match super#current_stmt with
- | None -> assert false
- | Some st -> st.sid
-
- method private current_kf =
- match super#current_function with
- | None -> None
- | Some fd -> Some (Globals.Functions.get fd)
-
- val mutable current_ca = None
-
- val mutable active_behaviors = []
-
- method private current_behavior_or_loop =
- match current_ca with
- None ->
- let active = Datatype.String.Set.of_list active_behaviors in
- Property.Id_contract (active ,Extlib.the self#current_behavior)
- | Some ca -> Property.Id_loop ca
-
- (* When [stmt] is a call, this method "inlines" the preconditions of the
- functions that may be called here, with some context. This way,
- bullets are more precise, etc. *)
- method private preconditions_at_call fmt stmt =
- match stmt.skind with
- | Instr (Call _)
- | Instr (Local_init (_, ConsInit _, _)) ->
- let extract_instance_predicate = function
- | Property.IPPropertyInstance (_kf, _stmt, pred, _prop) -> pred
- (* Other cases should not happen, unless a plugin has replaced call
- preconditions. In this case, print nothing but do not crash. *)
- | _ -> raise Not_found
- in
- let extract_predicate = function
- | Property.IPPredicate (_, _, _, p) -> p
- | _ -> assert false
- in
- (* Functons called at this point *)
- let called = Statuses_by_call.all_functions_with_preconditions stmt in
- let warn_missing = false in
- let add_by_kf kf acc =
- let ips =
- Statuses_by_call.all_call_preconditions_at ~warn_missing kf stmt
- in
- if ips = [] then acc else (kf, ips) :: acc
- in
- let ips_all_kfs = Kernel_function.Hptset.fold add_by_kf called [] in
- let pp_one fmt (original_p, p) =
- match extract_instance_predicate p with
- | Some pred -> Format.fprintf fmt "@[%a@]" self#requires_aux (p, pred)
- | None ->
- let pred = extract_predicate original_p in
- (* Makes the original predicate non clickable, as it may involve
- the formal parameters which are not in scope at the call site. *)
- Format.fprintf fmt "@[Non transposable: %s@]"
- (Format.asprintf "@[%a@]" self#requires_aux (original_p, pred))
- | exception Not_found -> ()
- in
- let pp_by_kf fmt (kf, ips) =
- Format.fprintf fmt "@[preconditions of %a:@]@ %a"
- Kernel_function.pretty kf
- (Pretty_utils.pp_list ~pre:"" ~sep:"@ " ~suf:"" pp_one) ips
- in
- if ips_all_kfs <> [] then
- Pretty_utils.pp_list ~pre:"@[<v 3>/* " ~sep:"@ " ~suf:" */@]@ "
- pp_by_kf fmt ips_all_kfs
- | _ -> ()
-
-
- method! next_stmt next fmt current =
- if Cil_datatype.Stmt.Hashtbl.mem unfold_preconds current
- then self#preconditions_at_call fmt current;
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PStmt (Extlib.the self#current_kf,current)))
- (super#next_stmt next) current
-
- method! lval fmt lv =
- match self#current_kinstr with
- | Kglobal -> super#lval fmt lv
- (* Do not highlight the lvals in initializers. *)
- | Kstmt _ as ki ->
- Format.fprintf fmt "@{<%s>"
- (Tag.create (PLval (self#current_kf,ki,lv)));
- (match lv with
- | Var vi, (Field _| Index _ as o) ->
- (* Small hack to be able to click on the arrays themselves
- in the easy cases *)
- self#lval fmt (Var vi, NoOffset);
- self#offset fmt o
- | _ -> super#lval fmt lv
- );
- Format.fprintf fmt "@}"
-
- method! exp fmt e =
- match e.enode with
- | Lval lv ->
- (* Do not mark immediate l-values as they would not be
- selectable anyway because of the embedded tags of self#lval.
- This is only an optimization. *)
- self#lval fmt lv
- | _ ->
- Format.fprintf fmt "@{<%s>"
- (Tag.create (PExp (self#current_kf,self#current_kinstr,e)));
- super#exp fmt e;
- Format.fprintf fmt "@}"
-
- method! term_lval fmt lv =
- (* similar to pLval, except that term_lval can appear in specifications
- of functions (ki = None, kf <> None). Initializers are ignored. *)
- if self#current_kinstr = Kglobal && self#current_kf = None then begin
- super#term_lval fmt lv (* Do not highlight the lvals in initializers. *)
- end else begin
- match current_property with
- | None -> (* Also use default printer for this case (possible inside
- pragmas, for example). *)
- super#term_lval fmt lv
- | Some ip ->
- Format.fprintf fmt "@{<%s>"
- (Tag.create
- (PTermLval (self#current_kf, self#current_kinstr, ip, lv)));
- (match lv with
- | TVar vi, (TField _| TIndex _ as o) ->
- self#term_lval fmt (TVar vi, TNoOffset);
- self#term_offset fmt o
- | _ -> super#term_lval fmt lv
- );
- Format.fprintf fmt "@}"
- end
-
- method! vdecl fmt vi =
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PVDecl (self#current_kf, self#current_kinstr, vi)))
- super#vdecl vi
-
- method private tag_property p =
- current_property <- Some p;
- Tag.create (PIP p)
-
- method! code_annotation fmt ca =
- match ca.annot_content with
- | APragma p when not (Logic_utils.is_property_pragma p) ->
- (* Not currently localizable. Will be linked to the next stmt *)
- super#code_annotation fmt ca
- | AAssert _ | AInvariant _ | APragma _ | AVariant _ ->
- let ip =
- Property.ip_of_code_annot_single
- (Extlib.the self#current_kf)
- (Extlib.the self#current_stmt)
- ca
- in
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property ip)
- super#code_annotation ca;
- | AStmtSpec (active,_) | AExtended(active,_,_) ->
- (* tags will be set in the inner nodes. *)
- active_behaviors <- active;
- super#code_annotation fmt ca;
- active_behaviors <- [];
- | AAllocation _
- | AAssigns _ ->
- (* tags will be set in the inner nodes. *)
- current_ca <- Some ca;
- super#code_annotation fmt ca;
- current_ca <- None
-
- method! global fmt g =
- match g with
- (* these globals are already covered by PVDecl *)
- | GVarDecl _ | GVar _ | GFunDecl _ | GFun _ -> super#global fmt g
- | _ ->
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PGlobal g))
- super#global
- g
-
- method! extended fmt ext =
- let loc =
- match self#current_kf with
- | None -> Property.ELGlob
- | Some kf -> Property.e_loc_of_stmt kf self#current_kinstr
- in
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property Property.(ip_of_extended loc ext))
- super#extended ext;
-
- method private requires_aux fmt (ip, p) =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property ip)
- super#requires p;
-
- method! requires fmt p =
- let b = Extlib.the self#current_behavior in
- let ip =
- Property.ip_of_requires
- (Extlib.the self#current_kf) self#current_kinstr b p
- in
- self#requires_aux fmt (ip, p)
-
- method! behavior fmt b =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_behavior
- (Extlib.the self#current_kf)
- self#current_kinstr
- active_behaviors b))
- super#behavior b
-
- method! decreases fmt t =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_decreases
- (Extlib.the self#current_kf) self#current_kinstr t))
- super#decreases t;
-
- method! terminates fmt t =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_terminates
- (Extlib.the self#current_kf) self#current_kinstr t))
- super#terminates t;
-
- method! complete_behaviors fmt t =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_complete
- (Extlib.the self#current_kf)
- self#current_kinstr
- active_behaviors
- t))
- super#complete_behaviors t
-
- method! disjoint_behaviors fmt t =
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_disjoint
- (Extlib.the self#current_kf)
- self#current_kinstr
- active_behaviors
- t))
- super#disjoint_behaviors t
-
- method! assumes fmt p =
- let b = Extlib.the self#current_behavior in
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_assumes
- (Extlib.the self#current_kf) self#current_kinstr b p))
- super#assumes p;
-
- method! post_cond fmt pc =
- let b = Extlib.the self#current_behavior in
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property
- (Property.ip_of_ensures
- (Extlib.the self#current_kf) self#current_kinstr b pc))
- super#post_cond pc;
-
- method! assigns s fmt a =
- match
- Property.ip_of_assigns (Extlib.the self#current_kf) self#current_kinstr
- self#current_behavior_or_loop a
- with
- None -> super#assigns s fmt a
- | Some ip ->
- Format.fprintf fmt "@{<%s>%a@}"
- (self#tag_property ip) (super#assigns s) a
-
- method! from s fmt ((_, f) as from) =
- match f with
- | FromAny -> super#from s fmt from
- | From _ ->
- let ip =
- Extlib.the
- (Property.ip_of_from
- (Extlib.the self#current_kf) self#current_kinstr
- self#current_behavior_or_loop from)
- in
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PIP ip)) (super#from s) from
-
- method! global_annotation fmt a =
- match Property.ip_of_global_annotation_single a with
- | None -> super#global_annotation fmt a
- | Some ip ->
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PIP ip)) super#global_annotation a
-
- method! allocation ~isloop fmt a =
- match
- Property.ip_of_allocation (Extlib.the self#current_kf) self#current_kinstr
- self#current_behavior_or_loop a
- with
- None -> super#allocation ~isloop fmt a
- | Some ip ->
- Format.fprintf fmt "@{<%s>%a@}"
- (Tag.create (PIP ip)) (super#allocation ~isloop) a;
-
- method! stmtkind sattr next fmt sk =
- (* Special tag denoting the start of the statement, WITHOUT any ACSL
- assertion/statement contract, etc. *)
- let s = Extlib.the self#current_stmt in
- Format.fprintf fmt "@{<gui:stmt_start%d>%a@}" s.sid (super#stmtkind sattr next) sk
-
- initializer force_brace <- true
-
- end
-end
+module Printer = Printer_tag.Make(Tag)
exception Found of int*int
@@ -683,29 +262,11 @@ let locate_localizable state loc =
with Found (b,e) -> Some (b,e)
let localizable_from_locs state ~file ~line =
- let loc_localizable = function
- | PStmt (_,st) | PLval (_,Kstmt st,_) | PExp(_,Kstmt st, _)
- | PTermLval(_,Kstmt st,_,_) ->
- Stmt.loc st
- | PIP ip ->
- (match Property.get_kinstr ip with
- | Kglobal ->
- (match Property.get_kf ip with
- None -> Location.unknown
- | Some kf -> Kernel_function.get_location kf)
- | Kstmt st -> Stmt.loc st)
- | PVDecl (_,_,vi) -> vi.vdecl
- | PGlobal g -> Global.loc g
- | (PLval _ | PTermLval _ | PExp _) as localize ->
- (match kf_of_localizable localize with
- | None -> Location.unknown
- | Some kf -> Kernel_function.get_location kf)
- in
let r = ref [] in
Locs.iter
state
(fun _ v ->
- let loc,_ = loc_localizable v in
+ let loc,_ = loc_of_localizable v in
if line = loc.Filepath.pos_lnum && loc.Filepath.pos_path = file then
r := v::!r);
!r
@@ -715,13 +276,7 @@ let buffer_formatter state source =
let emit_open_tag s =
(* Ignore tags that are not ours *)
if Extlib.string_prefix "guitag:" s then
- Stack.push (source#end_iter#offset, Tag.get s) starts
- else begin
- try
- let sid = Scanf.sscanf s "gui:stmt_start%d" Extlib.id in
- Locs.add_stmt_start state sid source#end_iter#offset
- with Scanf.Scan_failure _ | End_of_file -> ()
- end;
+ Stack.push (source#end_iter#offset, Tag.get s) starts ;
""
in
let emit_close_tag s =
@@ -789,6 +344,7 @@ let display_source globals
in
highlighter v ~start:pb ~stop:pe
with Not_found -> ())
+ | PStmtStart _
| PTermLval _ | PLval _ | PVDecl _ | PGlobal _
| PIP _ | PExp _ ->
highlighter v ~start:pb ~stop:pe
@@ -800,12 +356,10 @@ let display_source globals
in
Locs.set_hilite state hiliter;
let gtk_fmt = buffer_formatter state (source:>GText.buffer) in
- let pp = Printer.current_printer () in
- let module CurrentPP = (val pp: Printer.PrinterClass) in
- let module TagPrinterClass = TagPrinterClassDeferred(CurrentPP) in
- let tagPrinter = new TagPrinterClass.tagPrinterClass in
let display_global g =
- tagPrinter#global gtk_fmt g;
+ Printer.with_unfold_precond
+ are_preconds_unfolded
+ Printer.pp_global gtk_fmt g ;
Format.pp_print_flush gtk_fmt ()
in
let counter = ref 0 in
diff --git a/src/plugins/gui/pretty_source.mli b/src/plugins/gui/pretty_source.mli
index 452f6727f9c3217ba03954864aa1da903f57dc9c..998910fda3a1ea4ee3f3e09cebc6c09d69ddb8e9 100644
--- a/src/plugins/gui/pretty_source.mli
+++ b/src/plugins/gui/pretty_source.mli
@@ -25,9 +25,9 @@
open Cil_types
-(** The kind of object that can be selected in the source viewer. *)
-type localizable =
+type localizable = Printer_tag.localizable =
| PStmt of (kernel_function * stmt)
+ | PStmtStart of (kernel_function * stmt)
| PLval of (kernel_function option * kinstr * lval)
| PExp of (kernel_function option * kinstr * exp)
| PTermLval of (kernel_function option * kinstr * Property.t * term_lval)
@@ -41,8 +41,6 @@ type localizable =
definitions. *)
| PIP of Property.t
-module Localizable: Datatype.S with type t = localizable
-
module Locs: sig
type state
(** To call when the source buffer is about to be discarded *)
@@ -79,7 +77,6 @@ val locate_localizable : Locs.state -> localizable -> (int*int) option
(** @return Some (start,stop) in offset from start of buffer if the
given localizable has been displayed according to [Locs.locs]. *)
-
val kf_of_localizable : localizable -> kernel_function option
val ki_of_localizable : localizable -> kinstr
val varinfo_of_localizable : localizable -> varinfo option
diff --git a/src/plugins/gui/property_navigator.ml b/src/plugins/gui/property_navigator.ml
index 360a6326434a7a78bcc33e5d870c14ec8421c977..a859ed50bd7e119fa26cbd6f9f7983e7400d82ef 100644
--- a/src/plugins/gui/property_navigator.ml
+++ b/src/plugins/gui/property_navigator.ml
@@ -638,7 +638,7 @@ let make_panel (main_ui:main_window_extension_points) =
invariant.get ()
| Property.IPCodeAnnot(_,_,{annot_content = APragma p}) ->
Logic_utils.is_property_pragma p (* currently always false. *)
- | Property.IPCodeAnnot(_, _, _) -> assert false
+ | Property.IPCodeAnnot(_, _, _) -> false (* status of inner nodes *)
| Property.IPAllocation (_,Kglobal,_,_) -> allocations.get ()
| Property.IPAllocation (_,Kstmt _,Property.Id_loop _,_) ->
allocations.get ()
@@ -752,13 +752,10 @@ let make_panel (main_ui:main_window_extension_points) =
Aka. "bullets" in left margin *)
let highlighter (buffer:reactive_buffer) localizable ~start ~stop =
match localizable with
- | Pretty_source.PIP (Property.IPPredicate (Property.PKAssumes _,_,_,_)) ->
- (* Assumes clause do not get a bullet: there is nothing
- to prove about them.*)
- ()
| Pretty_source.PIP ppt ->
- Design.Feedback.mark
- buffer#buffer ~offset:start (Property_status.Feedback.get ppt)
+ if Property.has_status ppt then
+ Design.Feedback.mark
+ buffer#buffer ~offset:start (Property_status.Feedback.get ppt)
| Pretty_source.PStmt(_,({ skind=Instr(Call _| Local_init (_, ConsInit _, _)) } as stmt)) ->
let kfs = Statuses_by_call.all_functions_with_preconditions stmt in
(* We separate the consolidated statuses of the preconditions inside
@@ -813,7 +810,7 @@ let highlighter (buffer:reactive_buffer) localizable ~start ~stop =
in
Design.Feedback.mark buffer#buffer ~call_site:stmt ~offset validity
- | Pretty_source.PStmt _
+ | Pretty_source.PStmt _ | Pretty_source.PStmtStart _
| Pretty_source.PGlobal _| Pretty_source.PVDecl _
| Pretty_source.PTermLval _| Pretty_source.PLval _
| Pretty_source.PExp _ -> ()
diff --git a/src/plugins/gui/wutil.ml b/src/plugins/gui/wutil.ml
index 64421cb491ca77aab6056815a257086b0a8d803f..42ee0a7912af178d9047560d5c128b7d0b9efde8 100644
--- a/src/plugins/gui/wutil.ml
+++ b/src/plugins/gui/wutil.ml
@@ -26,36 +26,21 @@
let on x f = match x with None -> () | Some x -> f x
let fire fs x = List.iter (fun f -> f x) fs
-
-type ('a,'b) cell = Value of 'b | Fun of ('a -> 'b)
-let get p x =
- match !p with
- | Value y -> y
- | Fun f -> let y = f x in p := Value y ; y
-let once f = get (ref (Fun f))
+let once = Wutil_once.once
(* -------------------------------------------------------------------------- *)
(* --- Pango Properties --- *)
(* -------------------------------------------------------------------------- *)
-let small_font =
- once (fun f ->
- let f = Pango.Font.copy f in
- let s = Pango.Font.get_size f in
- Pango.Font.set_size f (s-2) ; f)
-
-let bold_font =
- once (fun f ->
- let f = Pango.Font.copy f in
- Pango.Font.set_weight f `BOLD ; f)
-
-let modify_font phi widget =
- widget#misc#modify_font (phi widget#misc#pango_context#font_description)
+include Gtk_compat.Pango
let set_font w name = w#misc#modify_font_by_name name
let set_monospace w = set_font w "monospace"
-let set_small_font w = modify_font small_font w
-let set_bold_font w = modify_font bold_font w
+
+(* -------------------------------------------------------------------------- *)
+(* --- Misc --- *)
+(* -------------------------------------------------------------------------- *)
+
let set_tooltip w m = on m w#misc#set_tooltip_text
let set_enabled (w : #GObj.widget) = w#misc#set_sensitive
let set_visible (w : #GObj.widget) e =
diff --git a/src/plugins/gui/wutil_once.ml b/src/plugins/gui/wutil_once.ml
new file mode 100644
index 0000000000000000000000000000000000000000..415eda7ef37bd8d8f39f3fe47bc35e49dd143574
--- /dev/null
+++ b/src/plugins/gui/wutil_once.ml
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+(* belongs to Wutil, but used by gtk_compat.{2,3}.ml *)
+
+type ('a,'b) cell = Value of 'b | Fun of ('a -> 'b)
+let get p x =
+ match !p with
+ | Value y -> y
+ | Fun f -> let y = f x in p := Value y ; y
+let once f = get (ref (Fun f))
diff --git a/src/plugins/gui/wutil_once.mli b/src/plugins/gui/wutil_once.mli
new file mode 100644
index 0000000000000000000000000000000000000000..60f48dded34de27016d132e4f0e2c51b5e64f9e7
--- /dev/null
+++ b/src/plugins/gui/wutil_once.mli
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(* *)
+(* This file is part of Frama-C. *)
+(* *)
+(* Copyright (C) 2007-2019 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+(** [once f] returns a function that will only be applied once per
+ execution of the program and returns the same value afterwards. *)
+val once: ('a -> 'b) -> 'a -> 'b
diff --git a/src/plugins/loop_analysis/loop_analysis.ml b/src/plugins/loop_analysis/loop_analysis.ml
index de7974e693b2dbf55feef29cd5271fc1bdbc12a7..a5966da7fa838445be7e6f3334c6f9ef7a320eac 100644
--- a/src/plugins/loop_analysis/loop_analysis.ml
+++ b/src/plugins/loop_analysis/loop_analysis.ml
@@ -439,7 +439,7 @@ module Store(* (B:sig *)
may be missed;
2. in '<=' and '>=' loops, to adjust for the last iteration *)
let divident = Integer.sub bound offset in
- let remainder = Integer.rem divident increment in
+ let remainder = Integer.e_rem divident increment in
(* check if induction variable may miss termination condition *)
if binop = Cil_types.Ne && not Integer.(equal remainder zero) then
Options.warning ~current:true
@@ -462,7 +462,7 @@ module Store(* (B:sig *)
success := true;
add_loop_bound stmt adjusted_value
end
- with Failure _ -> (* overflow in Integer.to_int *)
+ with Z.Overflow -> (* overflow in Integer.to_int *)
()
(* TODO: check if this is useful and does not cause false alarms
else
diff --git a/src/plugins/loop_analysis/slevel_analysis.ml b/src/plugins/loop_analysis/slevel_analysis.ml
index 26625cfa02de3c3ccd0c17a96f764ab233db90f1..b17e64142f2176234d8b015473c04eeb374d210a 100644
--- a/src/plugins/loop_analysis/slevel_analysis.ml
+++ b/src/plugins/loop_analysis/slevel_analysis.ml
@@ -112,7 +112,7 @@ module Specific(KF:sig val kf: Kernel_function.t end) = struct
Integer.power_int_positive_int in_loop_i (max_iteration + 1)
in
let slevel_inside_loop =
- Integer.div (Integer.pred s) (Integer.pred in_loop)
+ Integer.e_div (Integer.pred s) (Integer.pred in_loop)
in
let result = Integer.mul entry slevel_inside_loop in
(* Kernel.feedback "s %a slevel_inside_loop %a result %a" *)
@@ -123,9 +123,9 @@ module Specific(KF:sig val kf: Kernel_function.t end) = struct
then Some result
else raise Exit
with
- | Invalid_argument _ (* Possible exponent too big *)
- | Failure _ (* Integer too big *)
- | Exit -> (* Above MaxIterations. *)
+ | Invalid_argument _ (* Possible negative exponent *)
+ | Z.Overflow (* Integer too big *)
+ | Exit -> (* Above MaxIterations. *)
update_max_slevel_encountered
(Some (Integer.mul entry (Integer.mul in_loop
(Integer.of_int max_iteration))));
@@ -197,8 +197,7 @@ module SpecificNoBranches(KF:sig val kf: Kernel_function.t end) = struct
Some Integer.(pred (mul (succ (of_int in_loop_i))
(of_int max_iteration)))
with
- | Invalid_argument _ (* Possible exponent too big *)
- | Failure _ (* Integer too big *)
+ | Z.Overflow (* Integer too big *)
-> update_max_slevel_encountered
(Some (Integer.mul entry (Integer.mul in_loop
(Integer.of_int max_iteration))));
diff --git a/src/plugins/metrics/metrics_cilast.ml b/src/plugins/metrics/metrics_cilast.ml
index ca998ba41855e3cd990898ff02e1527f68ddb103..6474c0e06191a96073c31f18f4a0a7047b69f939 100644
--- a/src/plugins/metrics/metrics_cilast.ml
+++ b/src/plugins/metrics/metrics_cilast.ml
@@ -323,7 +323,7 @@ class slocVisitor ~libc : sloc_visitor = object(self)
| Dtype_annot (ta, _) -> ta.l_var_info.lv_name
| Dmodel_annot (mi, _) -> mi.mi_name
| Dcustom_annot (_c, _n, _, _) -> " (Custom) "
- | Dextended ((_, n, _, _), _, _) -> " (Extension " ^ n ^ ")"
+ | Dextended ((_, n, _, _, _), _, _) -> " (Extension " ^ n ^ ")"
end
method private images (globs:global list) =
diff --git a/src/plugins/occurrence/register_gui.ml b/src/plugins/occurrence/register_gui.ml
index f5de64c487702758a7c3581a8a0c5f8b5aef5d13..9fbba556725d43f3660638f10b1a9d21e4f993fd 100644
--- a/src/plugins/occurrence/register_gui.ml
+++ b/src/plugins/occurrence/register_gui.ml
@@ -134,7 +134,7 @@ let occurrence_highlighter buffer loc ~start ~stop =
if List.exists same_tlval result then highlight ()
| PVDecl(_, _,vi') when Varinfo.equal vi vi' ->
highlight ()
- | PExp _ | PVDecl _ | PStmt _ | PGlobal _ | PIP _ -> ()
+ | PExp _ | PVDecl _ | PStmt _ | PStmtStart _ | PGlobal _ | PIP _ -> ()
module FollowFocus =
State_builder.Ref
diff --git a/src/plugins/qed/term.ml b/src/plugins/qed/term.ml
index 99e54cad0af764e053ee1dafc7e361387e30b2e1..0c05374f3a184680de0625a57c77d8cbced021aa 100644
--- a/src/plugins/qed/term.ml
+++ b/src/plugins/qed/term.ml
@@ -1950,10 +1950,11 @@ struct
let rec lc_open m k v e =
if not (Bvars.contains k e.bind) then e else
match e.repr with
- | Bvar _ -> v
+ | Bvar _ -> v (* e.bind is a singleton that can only contains k *)
| _ ->
- try cache_find m e
- with Not_found -> cache_bind m e (rebuild (lc_open m k v) e)
+ if is_simple e then e else
+ try cache_find m e
+ with Not_found -> cache_bind m e (rebuild (lc_open m k v) e)
let lc_open_term t e =
let k = Bvars.order e.bind in
diff --git a/src/plugins/scope/dpds_gui.ml b/src/plugins/scope/dpds_gui.ml
index 6347c07315429e8aca621ee5c55d44b597ed0731..b8b5b779c6e3c6633c03f25b960ec6afb8c7ad35 100644
--- a/src/plugins/scope/dpds_gui.ml
+++ b/src/plugins/scope/dpds_gui.ml
@@ -466,7 +466,8 @@ let highlighter (buffer:Design.reactive_buffer) localizable ~start ~stop =
put_tag (ShowDef.tag_stmt stmt)
| PIP (Property.IPCodeAnnot (_, _, annot)) ->
put_tag (Pscope.tag_annot annot)
- | PExp _ | PVDecl _ | PTermLval _ | PLval _ | PGlobal _ | PIP _ -> ()
+ | PStmtStart _ | PExp _
+ | PVDecl _ | PTermLval _ | PLval _ | PGlobal _ | PIP _ -> ()
with Not_found -> ()
let check_value (main_ui:Design.main_window_extension_points) =
diff --git a/src/plugins/security_slicing/register_gui.ml b/src/plugins/security_slicing/register_gui.ml
index b18a51f45e0049294800154b8cf04ebc79acb208..685cbf1dc90463791d492c6761cfb4aedbff52a5 100644
--- a/src/plugins/security_slicing/register_gui.ml
+++ b/src/plugins/security_slicing/register_gui.ml
@@ -57,6 +57,7 @@ let security_highlighter buffer loc ~start ~stop =
if List.exists (fun k -> k.sid=s.sid) d then begin
let tag = make_tag buffer"direct" [`BACKGROUND "green" ] in
apply_tag buffer tag start stop end
+ | PStmtStart _
| PExp _ | PVDecl _ | PTermLval _ | PLval _ | PGlobal _ | PIP _ -> ()
let security_selector
diff --git a/src/plugins/slicing/register_gui.ml b/src/plugins/slicing/register_gui.ml
index 5a962f17d8a94827f442b5bf1ba59c97cff00158..1db715334e460398326438640136747c8b7ac786 100644
--- a/src/plugins/slicing/register_gui.ml
+++ b/src/plugins/slicing/register_gui.ml
@@ -461,6 +461,7 @@ let slicing_highlighter(buffer:Design.reactive_buffer) localizable ~start ~stop=
match localizable with
| Pretty_source.PStmt (kf,stmt) -> tag_stmt kf stmt start stop
| Pretty_source.PVDecl (Some kf,_,vi) -> tag_vdecl kf vi start stop
+ | Pretty_source.PStmtStart _
| Pretty_source.PVDecl (None,_,_)
| Pretty_source.PLval _
| Pretty_source.PTermLval _
diff --git a/src/plugins/value/domains/apron/apron_domain.ok.ml b/src/plugins/value/domains/apron/apron_domain.ok.ml
index 6c7817dff14e3c75d297c337029daa911d0d6d9a..27aa29d81c1fb68e1a7fccaddc91b732dd74962b 100644
--- a/src/plugins/value/domains/apron/apron_domain.ok.ml
+++ b/src/plugins/value/domains/apron/apron_domain.ok.ml
@@ -252,7 +252,7 @@ let translate_lval = function
let translate_constant = function
| CInt64 (i, _, _) -> begin
try Coeff.s_of_int (Integer.to_int i) (* TODO: skip OCaml int type *)
- with Failure _ -> raise (Out_of_Scope "translate_constant big int")
+ with Z.Overflow | Failure _ -> raise (Out_of_Scope "translate_constant big int")
end
| _ -> raise (Out_of_Scope "translate_constant not integer")
@@ -501,7 +501,7 @@ module Make
(* May happen when evaluating an expression in the GUI, while the states
of Apron have not been saved. In this case, we evaluate in the top
apron state, whose environment raises the Failure exception. *)
- | Failure _ -> top
+ | Z.Overflow | Failure _ -> top
let extract_expr _oracle state expr =
compute state expr (Cil.typeOf expr)
diff --git a/src/plugins/value/domains/cvalue/builtins_malloc.ml b/src/plugins/value/domains/cvalue/builtins_malloc.ml
index ae944aa55f87b4c15792a40735e33ef0c1bd7bee..b696a031f3ceb94b2b0dc803d4a12e2ebe6fbee8 100644
--- a/src/plugins/value/domains/cvalue/builtins_malloc.ml
+++ b/src/plugins/value/domains/cvalue/builtins_malloc.ml
@@ -192,7 +192,7 @@ let guess_intended_malloc_type stack sizev constant_size =
let nb_elems elem_size =
if constant_size && Int.equal size_min size_max
then Some (if Int.(equal elem_size zero) then Int.zero
- else Int.div size_min elem_size)
+ else Int.e_div size_min elem_size)
else None
in
let mk_typed_size t =
@@ -200,8 +200,8 @@ let guess_intended_malloc_type stack sizev constant_size =
| TPtr (t, _) when not (Cil.isVoidType t) ->
let s = Int.of_int (Cil.bytesSizeOf t) in
if Int.(equal s zero) ||
- (Int.equal (Int.rem size_min s) Int.zero &&
- Int.equal (Int.rem size_max s) Int.zero)
+ (Int.equal (Int.e_rem size_min s) Int.zero &&
+ Int.equal (Int.e_rem size_max s) Int.zero)
then
{ min_bytes = size_min; max_bytes = size_max;
elem_typ = t; nb_elems = nb_elems s }
diff --git a/src/plugins/value/domains/cvalue/builtins_print_c.ml b/src/plugins/value/domains/cvalue/builtins_print_c.ml
index f32792786051a017156a912f62ad8b92542688bb..7a05b4080187c54dd6760042e2a5dc35d6a9585e 100644
--- a/src/plugins/value/domains/cvalue/builtins_print_c.ml
+++ b/src/plugins/value/domains/cvalue/builtins_print_c.ml
@@ -227,12 +227,12 @@ let value_uninit_pretty cas prampamp lv s fmt = function
let offsetmap_pretty cas name print_ampamp fmt offsm =
let pretty_binding (bk,ek) (v, modu, offset) =
let iso = V_Or_Uninitialized.is_isotropic v in
- if Integer.is_zero (Integer.rem bk Integer.eight)
+ if Integer.is_zero (Integer.e_rem bk Integer.eight)
&& (Rel.is_zero offset)
- && (iso || (Integer.is_zero (Integer.rem modu Integer.eight)))
+ && (iso || (Integer.is_zero (Integer.e_rem modu Integer.eight)))
then
let ek = Integer.succ ek in
- if Integer.is_zero (Integer.rem ek Integer.eight)
+ if Integer.is_zero (Integer.e_rem ek Integer.eight)
then
let step = if iso then 1 else (Integer.to_int modu) / 8 in
let start = ref ((Integer.to_int bk) / 8) in
@@ -280,7 +280,7 @@ let state_pretty cas fmt m =
begin
try offsetmap_pretty cas name print_ampamp fmt offs
with
- | Failure _
+ | Z.Overflow
| Too_large_to_enumerate ->
Value_parameters.warning "base %s too large, \
will not print it" name
@@ -302,10 +302,10 @@ let print_declarations_for_malloc_bases fmt =
let dim =
match validity with
| Base.Known (l,u) when (Int.is_zero l)->
- Int.div (Int.succ u) Int.eight
+ Int.e_div (Int.succ u) Int.eight
| Base.Variable { Base.min_alloc; max_alloc } when
Int.(ge min_alloc zero && equal min_alloc max_alloc) ->
- Int.div (Int.succ min_alloc) Int.eight
+ Int.e_div (Int.succ min_alloc) Int.eight
| _ -> Kernel.abort ~current:true "got unexpected validity: %a"
Base.pretty_validity validity
in
diff --git a/src/plugins/value/domains/cvalue/builtins_string.ml b/src/plugins/value/domains/cvalue/builtins_string.ml
index d6c9c6040bdc299c6f7333e710b8a18838236c41..343dffefba4e16a5111823da6bb19630cc4551ef 100644
--- a/src/plugins/value/domains/cvalue/builtins_string.ml
+++ b/src/plugins/value/domains/cvalue/builtins_string.ml
@@ -170,7 +170,7 @@ let search_range kind ~min ~max (v, v_size, _v_shift) acc =
read_char kind offset v acc
else
(* The value [v] contains [nb_chars] characters: need [nb_chars] reads. *)
- let nb_chars = Integer.div v_size kind.size in
+ let nb_chars = Integer.e_div v_size kind.size in
(* Reads the [count]-nth character in [v]. *)
let rec do_one_char count ~max res =
let start = Integer.mul kind.size count in
@@ -222,9 +222,9 @@ let fold_offsm kind ~validity ~start ~max offsetmap acc =
overlaps between two ranges of the offsetmap.
- and either the value is isotropic, or the reads are aligned with the
repeated values. *)
- if Integer.is_zero (Integer.pos_rem (Integer.succ max) modu) &&
+ if Integer.is_zero (Integer.e_rem (Integer.succ max) modu) &&
(Cvalue.V_Or_Uninitialized.is_isotropic v ||
- Integer.(equal index v_start && is_zero (pos_rem v_size kind.size)))
+ Integer.(equal index v_start && is_zero (e_rem v_size kind.size)))
then search_range kind ~min:index ~max (v, v_size, v_shift) acc
else search_each_index kind ~validity ~index ~max offsetmap acc
in
diff --git a/src/plugins/value/domains/cvalue/builtins_watchpoint.ml b/src/plugins/value/domains/cvalue/builtins_watchpoint.ml
index fbebe367bbff602be7ae2806f782669b01358ff8..c8a2c01c80691c941addde50bee86e9388863795 100644
--- a/src/plugins/value/domains/cvalue/builtins_watchpoint.ml
+++ b/src/plugins/value/domains/cvalue/builtins_watchpoint.ml
@@ -89,7 +89,7 @@ let make_watch_cardinal target_value =
let target_value = Cvalue.V.project_ival target_value in
Cardinal (Integer.to_int (Ival.project_int target_value))
with V.Not_based_on_null | Ival.Not_Singleton_Int
- | Failure _ (* from Integer.to_int *) ->
+ | Z.Overflow (* from Integer.to_int *) ->
raise Db.Value.Outside_builtin_possibilities
let () =
diff --git a/src/plugins/value/domains/gauges/gauges_domain.ml b/src/plugins/value/domains/gauges/gauges_domain.ml
index e6845dd9d7764f6dd6d671e1143e04b3738958a1..ce361f8068a847ba4c0735e85ecc16a3cebad1e3 100644
--- a/src/plugins/value/domains/gauges/gauges_domain.ml
+++ b/src/plugins/value/domains/gauges/gauges_domain.ml
@@ -205,12 +205,12 @@ module G = struct
let div_towards_minus_infty x y =
if Integer.gt y Integer.zero
- then Integer.pos_div x y
- else Integer.(pos_div (neg x) (neg y))
+ then Integer.e_div x y
+ else Integer.(e_div (neg x) (neg y))
let div_towards_plus_infty x y =
if Integer.lt y Integer.zero
- then Integer.pos_div x y
- else Integer.(pos_div (neg x) (neg y))
+ then Integer.e_div x y
+ else Integer.(e_div (neg x) (neg y))
(* Computes the possible [n] such that [(add b)^n = r], when [f^n]
is [f] consecutive applications of [f]. *)
diff --git a/src/plugins/value/domains/hcexprs.ml b/src/plugins/value/domains/hcexprs.ml
index 449fe39ffdebac08675489ab196560b6d3d0ee5a..b8e0cea89a37659d753f192f72447a52d0f10c89 100644
--- a/src/plugins/value/domains/hcexprs.ml
+++ b/src/plugins/value/domains/hcexprs.ml
@@ -94,7 +94,11 @@ end
module HCE = struct
module S =
State_builder.Hashcons(E)
- (struct let dependencies = [Ast.self] let name = "" end)
+ (struct
+ let dependencies = [Ast.self]
+ let name = ""
+ let initial_values = []
+ end)
include S
diff --git a/src/plugins/value/domains/numerors/numerors_domain.ok.ml b/src/plugins/value/domains/numerors/numerors_domain.ok.ml
index daf171d6528b56b29e439ba2b843f0927a835d62..c385ee3a1f37c30e99efc18590ee2ddb462048fe 100644
--- a/src/plugins/value/domains/numerors/numerors_domain.ok.ml
+++ b/src/plugins/value/domains/numerors/numerors_domain.ok.ml
@@ -110,7 +110,7 @@ let add_numerors_value (module Value: Abstract_value.Internal) =
Numerors_value.of_ints ~prec min max
| _, _ -> num
(* Integer.to_int may fail for too big integers. *)
- with Cvalue.V.Not_based_on_null | Failure _ -> num
+ with Cvalue.V.Not_based_on_null | Z.Overflow -> num
end
| _, _ -> num
in
diff --git a/src/plugins/value/gui_files/register_gui.ml b/src/plugins/value/gui_files/register_gui.ml
index d08b1885786992b4d040968c64670554f8fb6eab..08eabb21cd9325eac38793407301dfa4287d6779 100644
--- a/src/plugins/value/gui_files/register_gui.ml
+++ b/src/plugins/value/gui_files/register_gui.ml
@@ -479,7 +479,7 @@ module Select (Eval: Eval) = struct
| PExp ((_,Kglobal,_) | (None, Kstmt _, _))
| PTermLval (None, _, _, _)-> ()
| PVDecl (_kf,_ki,_vi) -> ()
- | PGlobal _ | PIP _ -> ()
+ | PGlobal _ | PIP _ | PStmtStart _ -> ()
with
| Eval_terms.LogicEvalError ee ->
main_ui#pretty_information "Cannot evaluate term: %a@."
@@ -519,6 +519,7 @@ module Select (Eval: Eval) = struct
| _ -> ()
)
end
+ | PStmtStart _
| PVDecl (None, _, _) | PExp _ | PTermLval _ | PGlobal _ | PIP _ -> ()
let _right_click_value_not_computed (main_ui:main_ui) (menu:menu) localizable =
diff --git a/src/plugins/value/legacy/eval_op.ml b/src/plugins/value/legacy/eval_op.ml
index ce1da249d7ff3a4dc6ddf6b9b77d02544940d87f..7e919716a71686e0ea10fd1043fd25dcfda091a7 100644
--- a/src/plugins/value/legacy/eval_op.ml
+++ b/src/plugins/value/legacy/eval_op.ml
@@ -102,7 +102,7 @@ let reduce_by_initialized_defined f loc state =
if v' != v then begin
if V_Or_Uninitialized.is_bottom v' then raise Reduce_to_bottom;
let il = Int.max offl ll and ih = Int.min offh lh in
- let abs_shift = Integer.pos_rem (Rel.add_abs offl shift) modu in
+ let abs_shift = Integer.e_rem (Rel.add_abs offl shift) modu in
(* il and ih are the bounds of the interval to reduce.
We change the initialized flags in the following cases:
- either we overwrite entire values, or the partly overwritten
@@ -110,12 +110,12 @@ let reduce_by_initialized_defined f loc state =
- or we do not lose information on misaligned or partial values:
the result is a singleton *)
if V_Or_Uninitialized.(cardinal_zero_or_one v' || is_isotropic v') ||
- ((Int.equal offl il || Int.equal (Int.pos_rem ll modu) abs_shift) &&
+ ((Int.equal offl il || Int.equal (Int.e_rem ll modu) abs_shift) &&
(Int.equal offh ih ||
- Int.equal (Int.pos_rem (Int.succ lh) modu) abs_shift))
+ Int.equal (Int.e_rem (Int.succ lh) modu) abs_shift))
then
let diff = Rel.sub_abs il offl in
- let shift_il = Rel.pos_rem (Rel.sub shift diff) modu in
+ let shift_il = Rel.e_rem (Rel.sub shift diff) modu in
V_Offsetmap.add (il, ih) (v', modu, shift_il) acc
else acc
end
@@ -234,7 +234,7 @@ let find_offsm_under validity ival size offsm acc =
| Tr_offset.Interval (min, max, modu) ->
let process (start, _stop) (v, v_size, v_offset) acc =
if Rel.(equal v_offset zero) && Int.equal v_size size
- && Int.equal (Int.pos_rem (Int.sub start min) modu) Int.zero
+ && Int.equal (Int.e_rem (Int.sub start min) modu) Int.zero
then add_if_singleton v acc
else acc
in
diff --git a/src/plugins/value/legacy/eval_terms.ml b/src/plugins/value/legacy/eval_terms.ml
index 1b237eb589ee34e3a7dd7d79530a7dbabe304302..bd7d695d4566cc4694907fb0970c6443f2df610a 100644
--- a/src/plugins/value/legacy/eval_terms.ml
+++ b/src/plugins/value/legacy/eval_terms.ml
@@ -939,11 +939,11 @@ let rec eval_term ~alarm_mode env t =
frontiers are always 0 or 8*k-1 (because validity is in bits and
starts on zero), so we add 1 everywhere, then divide by eight. *)
let convert start_bits end_bits =
- let congr_succ i = Int.(equal zero (rem (succ i) eight)) in
+ let congr_succ i = Int.(equal zero (e_rem (succ i) eight)) in
let congr_or_zero i = Int.(equal zero i || congr_succ i) in
assert (congr_or_zero start_bits || congr_or_zero end_bits);
- let start_bytes = Int.(pos_div (Int.succ start_bits) eight) in
- let end_bytes = Int.(pos_div (Int.succ end_bits) eight) in
+ let start_bytes = Int.(e_div (Int.succ start_bits) eight) in
+ let end_bytes = Int.(e_div (Int.succ end_bits) eight) in
Ival.inject_range (Some start_bytes) (Some end_bytes)
in
match Base.validity b with
diff --git a/src/plugins/value/slevel/per_stmt_slevel.ml b/src/plugins/value/slevel/per_stmt_slevel.ml
index 6d07d943e250a6db6bd7007a021c8a5a46aef69c..4c9b5b4fe09d3e4dcc77cf0f66ada2aecad65cda 100644
--- a/src/plugins/value/slevel/per_stmt_slevel.ml
+++ b/src/plugins/value/slevel/per_stmt_slevel.ml
@@ -54,7 +54,7 @@ let retrieve_annot lt =
| _ -> LDefault (* be kind. Someone is bound to write a visitor that will
simplify our term into something unrecognizable... *)
-let () = Logic_typing.register_code_annot_next_stmt_extension "slevel"
+let () = Logic_typing.register_code_annot_next_stmt_extension "slevel" false
(fun ~typing_context:_ ~loc args ->
let abort () =
Value_parameters.abort ~source:(fst loc) "Invalid slevel directive"
@@ -115,7 +115,7 @@ let extract_slevel_directive s =
let rec find_one l =
match l with
| [] -> None
- | {annot_content = AExtended(_,_,(_,"slevel", _, Ext_terms lp))} :: _ ->
+ | {annot_content = AExtended(_,_,(_,"slevel", _, _,Ext_terms lp))} :: _ ->
Some (retrieve_annot lp)
| _ :: q -> find_one q
in
diff --git a/src/plugins/value/slevel/split_strategy.ml b/src/plugins/value/slevel/split_strategy.ml
index cc8b20271d996dcc80bd9b6c414945a7abd545c3..9ab22e48e569688454dd2bb2a64bd81b07646e44 100644
--- a/src/plugins/value/slevel/split_strategy.ml
+++ b/src/plugins/value/slevel/split_strategy.ml
@@ -80,7 +80,7 @@ let of_string s =
let r = Str.regexp ":" in
let conv s =
try Integer.of_string s
- with Failure _ -> raise (ParseFailure s)
+ with Invalid_argument _ -> raise (ParseFailure s)
in SplitEqList (List.map conv (Str.split r s))
let to_string = function
diff --git a/src/plugins/value/utils/library_functions.ml b/src/plugins/value/utils/library_functions.ml
index 0cb2c758547d844a1af22eb5b4376b1d3c459a98..f9abcf51c3c3ddeab1fdcc9152b23ce7cf61f99e 100644
--- a/src/plugins/value/utils/library_functions.ml
+++ b/src/plugins/value/utils/library_functions.ml
@@ -79,6 +79,7 @@ let unsupported_specifications =
"strdup", "string.c";
"strndup", "string.c";
"getenv", "stdlib.c";
+ "posix_memalign", "stdlib.c";
"putenv", "stdlib.c";
"setenv", "stdlib.c";
"unsetenv", "stdlib.c"
diff --git a/src/plugins/value/utils/unroll_annots.ml b/src/plugins/value/utils/unroll_annots.ml
index 8ef330e7a56731f5a03e374463a54299eb1d380d..3c2ae1c955ca2d81332b6c8ccd7ae388f5dd7b2e 100644
--- a/src/plugins/value/utils/unroll_annots.ml
+++ b/src/plugins/value/utils/unroll_annots.ml
@@ -26,7 +26,7 @@ exception Parse_error of string option
let parse_error ?msg () = raise (Parse_error msg)
-let () = Logic_typing.register_code_annot_next_loop_extension "unroll"
+let () = Logic_typing.register_code_annot_next_loop_extension "unroll" false
begin fun ~typing_context ~loc:_ args ->
match args with
| [arg] ->
@@ -48,7 +48,7 @@ let get_unroll_terms stmt =
(fun _emitter annot acc ->
match annot with
| {annot_content =
- AExtended (_, true, (_, "unroll", _,Ext_terms [term]))} ->
+ AExtended (_, true, (_, "unroll", _,_,Ext_terms [term]))} ->
term :: acc
| _ -> acc
) stmt []
diff --git a/src/plugins/value/utils/widen_hints_ext.ml b/src/plugins/value/utils/widen_hints_ext.ml
index 4917e6810c90b5d0d315a24bde976b79dd1442db..f9c808f43ee687b0c9e98c9ad8b674e49a1d8090 100644
--- a/src/plugins/value/utils/widen_hints_ext.ml
+++ b/src/plugins/value/utils/widen_hints_ext.ml
@@ -137,7 +137,7 @@ let widen_hint_terms_of_terms terms =
with
Invalid_hint -> None
-let () = Logic_typing.register_code_annot_next_both_extension "widen_hints"
+let () = Logic_typing.register_code_annot_next_both_extension "widen_hints" false
(fun ~typing_context ~loc args ->
let var_term, hint_terms =
terms_of_parsed_widen_hints typing_context loc args
@@ -167,7 +167,7 @@ let get_widen_hints_annots stmt =
(fun _emitter annot acc ->
match annot with
| {annot_content =
- AExtended (_, _,(_,"widen_hints", _, Ext_terms terms))} ->
+ AExtended (_, _,(_,"widen_hints", _, _,Ext_terms terms))} ->
(* loop widen_hints *)
acc @ [terms]
| _ -> acc
diff --git a/src/plugins/value_types/cvalue.ml b/src/plugins/value_types/cvalue.ml
index 86e61503023a0e0a5a52bc0dff2daa06f7a2a4e4..f6306e870ba5213e56daa45aca32fe0682244f44 100644
--- a/src/plugins/value_types/cvalue.ml
+++ b/src/plugins/value_types/cvalue.ml
@@ -635,7 +635,7 @@ module V = struct
if Integer.is_zero factor
then v
else topify_with_origin_kind topify v
- | Integer.Too_big -> top_int
+ | Z.Overflow -> top_int
let restrict_topint_to_size value size =
if is_topint value
@@ -979,7 +979,7 @@ module V_Offsetmap = struct
if Integer.is_zero cardinal then Integer.one else cardinal
in
let cardinalf = CardinalEstimate.of_integer cardinal in
- let repeat = Integer.(div (length start stop) size) in
+ let repeat = Integer.(e_div (length start stop) size) in
(* If a value is "cut", we still count it as if it were whole. *)
let repeat = Integer.(max repeat one) in
let cardinalf_repeated = CardinalEstimate.power cardinalf repeat in
diff --git a/src/plugins/value_types/widen_type.ml b/src/plugins/value_types/widen_type.ml
index 7f05346b3e9d56a45b2dadca0d11a8f5cf87301d..ed9929b21d0917513bdb7f8b466769f415639d33 100644
--- a/src/plugins/value_types/widen_type.ml
+++ b/src/plugins/value_types/widen_type.ml
@@ -141,7 +141,7 @@ let hints_for_base default_hints hints_by_base b =
(* Try the frontier of the block: further accesses are invalid
anyway. This also works great for constant strings (this computes
the offset of the null terminator). *)
- let bound = Integer.(pred (div (succ m) eight)) in
+ let bound = Integer.(pred (e_div (succ m) eight)) in
Ival.Widen_Hints.add bound widen_zero
| Base.Empty | Base.Invalid -> widen_zero
)
diff --git a/src/plugins/wp/Auto.ml b/src/plugins/wp/Auto.ml
index c06565117dbefde36dc23a426b09aedadfb82cc5..86d62474d957176721e555f38477e58f3346b108 100644
--- a/src/plugins/wp/Auto.ml
+++ b/src/plugins/wp/Auto.ml
@@ -162,12 +162,12 @@ struct
Tmap.interf
(fun _ a b ->
try Some(Integer.to_int a,Integer.to_int b)
- with Integer.Too_big -> None
+ with Z.Overflow -> None
) rg.vmin rg.vmax
let small = function
| None -> None
- | Some z -> try Some(Integer.to_int z) with Integer.Too_big -> None
+ | Some z -> try Some(Integer.to_int z) with Z.Overflow -> None
let bounds rg =
Tmap.merge
diff --git a/src/plugins/wp/Auto.mli b/src/plugins/wp/Auto.mli
index cd8447405dc1e8073b28c84f85b632c7592faa50..b91ae66a573fdf480367c2f5ba86429f9a2e6a83 100644
--- a/src/plugins/wp/Auto.mli
+++ b/src/plugins/wp/Auto.mli
@@ -35,7 +35,7 @@ val contrapose : ?priority:float -> selection -> strategy
val compound : ?priority:float -> selection -> strategy
val cut : ?priority:float -> ?modus:bool -> selection -> strategy
val filter : ?priority:float -> ?anti:bool -> unit -> strategy
-val havoc : ?priority:float -> havoc:selection -> addr:selection -> strategy
+val havoc : ?priority:float -> havoc:selection -> strategy
val separated : ?priority:float -> selection -> strategy
val instance : ?priority:float -> selection -> selection list -> strategy
val lemma : ?priority:float -> ?at:selection -> string -> selection list -> strategy
diff --git a/src/plugins/wp/Cfloat.ml b/src/plugins/wp/Cfloat.ml
index 81842f01a2eb694506b55e6640baba76d03a7870..a62ca61f74f49ede1bd466217377af4d37ba2a55 100644
--- a/src/plugins/wp/Cfloat.ml
+++ b/src/plugins/wp/Cfloat.ml
@@ -45,9 +45,8 @@ let ftau = function
| Float32 -> t32
| Float64 -> t64
-let pp_suffix fmt = function
- | Float32 -> Format.pp_print_string fmt "f32"
- | Float64 -> Format.pp_print_string fmt "f64"
+let ft_suffix = function Float32 -> "f32" | Float64 -> "f64"
+let pp_suffix fmt ft = Format.pp_print_string fmt (ft_suffix ft)
let link phi = Lang.infoprover (Qed.Engine.F_call phi)
@@ -135,15 +134,16 @@ let fmake ulp value = match ulp with
| Float64 -> F.e_fun fq64 [F.e_float value]
let qmake ulp q = fmake ulp (Transitioning.Q.to_float q)
-let mantissa = "\\([-+]?[0-9]*\\)"
-let comma = "\\(.\\(\\(0*[1-9]\\)*\\)0*\\)?"
-let exponent = "\\([eE]\\([-+]?[0-9]*\\)\\)?"
-let suffix = "\\([flFL]\\)?"
-let real = Str.regexp (mantissa ^ comma ^ exponent ^ suffix ^ "$")
+let re_mantissa = "\\([-+]?[0-9]*\\)"
+let re_comma = "\\(.\\(\\(0*[1-9]\\)*\\)0*\\)?"
+let re_exponent = "\\([eE]\\([-+]?[0-9]*\\)\\)?"
+let re_suffix = "\\([flFL]\\)?"
+let re_real =
+ Str.regexp (re_mantissa ^ re_comma ^ re_exponent ^ re_suffix ^ "$")
let parse_literal ~model v r =
try
- if Str.string_match real r 0 then
+ if Str.string_match re_real r 0 then
let has_suffix =
try ignore (Str.matched_group 7 r) ; true
with Not_found -> false in
@@ -217,19 +217,52 @@ let make_pred_float name op ft =
Lang.F.set_builtin phi (compute op ft) ;
REGISTRY.define phi (op,ft) ; phi
-let register = Ctypes.f_memo
+let f_memo = Ctypes.f_memo
-let real_of_flt = register (make_fun_float ~result:Logic.Real "of" REAL)
-let flt_of_real = register (make_fun_float "to" ROUND)
-let flt_add = register (make_fun_float "add" ADD)
-let flt_mul = register (make_fun_float "mul" MUL)
-let flt_div = register (make_fun_float "div" DIV)
-let flt_neg = register (make_fun_float "neg" NEG)
+let real_of_flt = f_memo (make_fun_float ~result:Logic.Real "of" REAL)
+let flt_of_real = f_memo (make_fun_float "to" ROUND)
+let flt_add = f_memo (make_fun_float "add" ADD)
+let flt_mul = f_memo (make_fun_float "mul" MUL)
+let flt_div = f_memo (make_fun_float "div" DIV)
+let flt_neg = f_memo (make_fun_float "neg" NEG)
-let flt_lt = register (make_pred_float "lt" LT)
-let flt_eq = register (make_pred_float "eq" EQ)
-let flt_le = register (make_pred_float "le" LE)
-let flt_neq = register (make_pred_float "ne" NE)
+let flt_lt = f_memo (make_pred_float "lt" LT)
+let flt_eq = f_memo (make_pred_float "eq" EQ)
+let flt_le = f_memo (make_pred_float "le" LE)
+let flt_neq = f_memo (make_pred_float "ne" NE)
+
+(* -------------------------------------------------------------------------- *)
+(* --- Builtins --- *)
+(* -------------------------------------------------------------------------- *)
+
+let register_builtin_comparison suffix ft =
+ begin
+ let open Qed.Logic in
+ let params = [Sdata;Sdata] in
+ let sort = Sprop in
+ let gt = generated_f ~params ~sort "\\gt_%s" suffix in
+ let ge = generated_f ~params ~sort "\\ge_%s" suffix in
+ let open LogicBuiltins in
+ let signature = [F ft;F ft] in
+ add_builtin ("\\eq_" ^ suffix) signature (flt_eq ft) ;
+ add_builtin ("\\ne_" ^ suffix) signature (flt_neq ft) ;
+ add_builtin ("\\lt_" ^ suffix) signature (flt_lt ft) ;
+ add_builtin ("\\le_" ^ suffix) signature (flt_le ft) ;
+ add_builtin ("\\gt_" ^ suffix) signature gt ;
+ add_builtin ("\\ge_" ^ suffix) signature ge ;
+ Context.register
+ begin fun () ->
+ let compute phi x y = e_fun phi [y;x] in
+ Lang.F.set_builtin_2 gt (compute (flt_lt ft)) ;
+ Lang.F.set_builtin_2 ge (compute (flt_le ft)) ;
+ end
+ end
+
+let () =
+ begin
+ register_builtin_comparison "float" Float32 ;
+ register_builtin_comparison "double" Float64 ;
+ end
(* -------------------------------------------------------------------------- *)
(* --- Models --- *)
@@ -238,13 +271,13 @@ let flt_neq = register (make_pred_float "ne" NE)
let () =
begin
let open LogicBuiltins in
- let register ft =
+ let register_builtin ft =
add_builtin "\\model" [F ft] (f_model ft) ;
add_builtin "\\delta" [F ft] (f_delta ft) ;
add_builtin "\\epsilon" [F ft] (f_epsilon ft) ;
in
- register Float32 ;
- register Float64 ;
+ register_builtin Float32 ;
+ register_builtin Float64 ;
end
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/Changelog b/src/plugins/wp/Changelog
index 65843136872b5e143fc4ce3420645d94c8a8c47e..7cf2a73dd9a1616da302af686a11a21ad0d485b4 100644
--- a/src/plugins/wp/Changelog
+++ b/src/plugins/wp/Changelog
@@ -20,6 +20,8 @@
# <Prover>: prover
###############################################################################
+- Wp [2019/28/01] Now -wp-dynamic is set by default (annotation @calls)
+
- Wp [2019/01/28] New floating-point model
- WP [2018/02/16] Filter out some variables from separation
- TIP [2018/02/15] Extend bitwise-eq auto-strategy on hypotheses
diff --git a/src/plugins/wp/Cint.ml b/src/plugins/wp/Cint.ml
index a4c3d080764c24e54f4eb4e71a9e4981d951774a..02c88290a4e5bf52db262ee8661d51cce8d337a2 100644
--- a/src/plugins/wp/Cint.ml
+++ b/src/plugins/wp/Cint.ml
@@ -609,7 +609,7 @@ let smp_eq_with_lnot a b = (* b1==~e <==> ~b1==e *)
let two_power_k_minus1 k =
try Integer.pred (Integer.two_power k)
- with Integer.Too_big -> raise Not_found
+ with Z.Overflow -> raise Not_found
let smp_eq_with_lsl_cst a0 b0 =
let b1 = match_integer b0 in
diff --git a/src/plugins/wp/Cint.mli b/src/plugins/wp/Cint.mli
index 263c43e16af4d329a7578bcb4d3890451ccd90be..a78c5b919096d068d016650c23cfdbca586f78bc 100644
--- a/src/plugins/wp/Cint.mli
+++ b/src/plugins/wp/Cint.mli
@@ -77,10 +77,10 @@ val f_bitwised : lfun list (** All except f_bit *)
(** Simplifiers *)
-val is_cint_simplifier: Conditions.simplifier
+val is_cint_simplifier: simplifier
(** Remove the [is_cint] in formulas that are
redundant with other conditions. *)
-val mask_simplifier: Conditions.simplifier
+val mask_simplifier: simplifier
val is_positive_or_null: term -> bool
diff --git a/src/plugins/wp/Cmath.mli b/src/plugins/wp/Cmath.mli
index e27a286e076c264de3d18f930b477a3019700f5c..7c1510ffdc31ba5d0463ffb389a324544528f07e 100644
--- a/src/plugins/wp/Cmath.mli
+++ b/src/plugins/wp/Cmath.mli
@@ -34,3 +34,5 @@ val f_real_of_int : lfun
val f_iabs : lfun
val f_rabs : lfun
val f_sqrt : lfun
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/Conditions.ml b/src/plugins/wp/Conditions.ml
index aa3a1478d52da357018dc3b254a78f684a5f0fbf..1fac69012b52aeae87e0b8ee5df50b9315ac4c54 100644
--- a/src/plugins/wp/Conditions.ml
+++ b/src/plugins/wp/Conditions.ml
@@ -845,23 +845,6 @@ and letify_case sigma ~target ~export seq =
(* --- External Simplifier --- *)
(* -------------------------------------------------------------------------- *)
-exception Contradiction
-
-class type simplifier =
- object
- method name : string
- method copy : simplifier
- method assume : F.pred -> unit
- method target : F.pred -> unit
- method fixpoint : unit
- method infer : F.pred list
-
- method simplify_exp : F.term -> F.term
- method simplify_hyp : F.pred -> F.pred
- method simplify_branch : F.pred -> F.pred
- method simplify_goal : F.pred -> F.pred
- end
-
let simplify_exp solvers e =
List.fold_left (fun e s -> s#simplify_exp e) e solvers
let simplify_goal solvers p =
diff --git a/src/plugins/wp/Conditions.mli b/src/plugins/wp/Conditions.mli
index 46607fa5871173d89b7e1b914b7de19f670f60cb..7a5c2b853e04159878577d9fd5b6a21d531a78be 100644
--- a/src/plugins/wp/Conditions.mli
+++ b/src/plugins/wp/Conditions.mli
@@ -180,36 +180,10 @@ val bundle : bundle -> sequence
(** {2 Simplifier} *)
-exception Contradiction
-
-class type simplifier =
- object
- method name : string
- method copy : simplifier
- method assume : F.pred -> unit
- (** Assumes the hypothesis *)
- method target : F.pred -> unit
- (** Give the predicate that will be simplified later *)
- method fixpoint : unit
- (** Called after assuming hypothesis and knowing the goal *)
- method infer : F.pred list
- (** Add new hypotheses implied by the original hypothesis. *)
-
- method simplify_exp : F.term -> F.term
- (** Currently simplify an expression. *)
- method simplify_hyp : F.pred -> F.pred
- (** Currently simplify an hypothesis before assuming it. In any
- case must return a weaker formula. *)
- method simplify_branch : F.pred -> F.pred
- (** Currently simplify a branch condition. In any case must return an
- equivalent formula. *)
- method simplify_goal : F.pred -> F.pred
- (** Simplify the goal. In any case must return a stronger formula. *)
- end
-
val clean : sequent -> sequent
val filter : sequent -> sequent
val parasite : sequent -> sequent
val simplify : ?solvers:simplifier list -> ?intros:int -> sequent -> sequent
val pruning : ?solvers:simplifier list -> sequent -> sequent
+
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/Filtering.ml b/src/plugins/wp/Filtering.ml
index a74546d4d09099ff3e3c7f25d99d70cd631f4468..adf5bbd31779b2ab6a62b9f9f1ffcfd97ce8d63f 100644
--- a/src/plugins/wp/Filtering.ml
+++ b/src/plugins/wp/Filtering.ml
@@ -211,7 +211,7 @@ struct
begin match F.repr k with
| Kint z ->
let d =
- try Dindex(Integer.to_int z) with Integer.Too_big -> Darray in
+ try Dindex(Integer.to_int z) with Z.Overflow -> Darray in
X( x , ds @ [ d ] )
| _ ->
let ds = ds @ [ Darray ] in
diff --git a/src/plugins/wp/GuiGoal.ml b/src/plugins/wp/GuiGoal.ml
index 5b8539b2c9085ede840a8c805c957d1834529ab5..9ba3bf0cc946a7afb8a246f85e5c5817624d3900 100644
--- a/src/plugins/wp/GuiGoal.ml
+++ b/src/plugins/wp/GuiGoal.ml
@@ -87,7 +87,7 @@ class pane (proverpane : GuiConfig.provers) =
in
let scroll_palette_widget = new Wutil.gobj_widget scroll_palette in
let palette = new Wpalette.panel () in
- let () = scroll_palette#add palette#coerce in
+ let () = scroll_palette#add_with_viewport palette#coerce in
let help = new Widget.button
~label:"Tactics" ~border:false ~tooltip:"List Available Tactics" () in
let delete = new Widget.button
@@ -357,13 +357,13 @@ class pane (proverpane : GuiConfig.provers) =
printer#set_target Tactical.Empty ;
strategies#connect None ;
List.iter (fun tactic -> tactic#clear) tactics
- | Some(model,sequent,sel) ->
+ | Some(model,tree,sequent,sel) ->
strategies#connect (Some (self#strategies sequent)) ;
let select (tactic : GuiTactic.tactic) =
let process = self#apply in
let composer = self#compose in
let browser = self#browse in
- tactic#select ~process ~composer ~browser sel
+ tactic#select ~process ~composer ~browser ~tree sel
in
Model.with_model model (List.iter select) tactics ;
let tgt =
@@ -470,7 +470,7 @@ class pane (proverpane : GuiConfig.provers) =
let sequent = printer#sequent in
let select = printer#selection in
let model = wpo.Wpo.po_model in
- self#update_tactics (Some(model,sequent,select)) ;
+ self#update_tactics (Some(model,proof,sequent,select)) ;
end
| Composer _ | Browser _ -> ()
@@ -551,7 +551,7 @@ class pane (proverpane : GuiConfig.provers) =
let n = Task.size pool in
if n = 0 then
begin
- ignore (ProofEngine.commit ~resolve:false fork) ;
+ ignore (ProofEngine.commit fork) ;
ProofEngine.validate proof ;
ProofEngine.forward proof ;
state <- Proof proof ;
diff --git a/src/plugins/wp/GuiNavigator.ml b/src/plugins/wp/GuiNavigator.ml
index 7da1c5d3d9f9a6dc365f93b24f5c4d18001792ee..0b97d0de9e790f28775d5e04d2d93fd736323ddd 100644
--- a/src/plugins/wp/GuiNavigator.ml
+++ b/src/plugins/wp/GuiNavigator.ml
@@ -123,7 +123,7 @@ class behavior
method reload () =
begin
list#reload ;
- let to_prove g = not (Wpo.is_proved g || Wpo.resolve g) in
+ let to_prove g = not (Wpo.is_proved g || Wpo.reduce g) in
let has_proof g =
match ProofEngine.get g with
| `None -> false
diff --git a/src/plugins/wp/GuiSource.ml b/src/plugins/wp/GuiSource.ml
index a47a570c5e8b4a1d5f55009509fb53cf9c23f1e1..f08f6d217e1dfd4d3f0f360b62990008680a3285 100644
--- a/src/plugins/wp/GuiSource.ml
+++ b/src/plugins/wp/GuiSource.ml
@@ -42,7 +42,7 @@ and call = {
}
let selection_of_localizable = function
- | PStmt( kf , stmt )
+ | PStmt( kf , stmt ) | PStmtStart( kf , stmt )
| PLval( Some kf , Kstmt stmt , _ )
| PTermLval( Some kf , Kstmt stmt , _, _ ) ->
begin
@@ -250,7 +250,8 @@ class highlighter (main:Design.main_window_extension_points) =
if DEPS.mem ip deps then
apply_depend buffer start stop
end
- | PGlobal _|PVDecl _|PTermLval _|PLval _| PExp _ -> ()
+ | PStmtStart _ | PGlobal _
+ | PVDecl _ | PTermLval _ | PLval _ | PExp _ -> ()
end
end
diff --git a/src/plugins/wp/GuiTactic.ml b/src/plugins/wp/GuiTactic.ml
index 40c8cf7256f05158a0364caaaad11889f2107349..a71c86bd8a48d1f81cbfc6e44352367def4e89a8 100644
--- a/src/plugins/wp/GuiTactic.ml
+++ b/src/plugins/wp/GuiTactic.ml
@@ -340,6 +340,7 @@ let wfield tac form pp = function
(* -------------------------------------------------------------------------- *)
type edited = {
+ tree : ProofEngine.tree ;
target : selection ;
browser : (browser -> unit) ;
composer : (composer -> unit) ;
@@ -388,6 +389,10 @@ class tactic
(* --- Feedback API --- *)
(* -------------------------------------------------------------------------- *)
+ method pool = match edited with
+ | None -> assert false
+ | Some { tree } -> ProofEngine.pool tree
+
method interactive = self#is_active
method get_title = title
method has_error = error
@@ -437,8 +442,8 @@ class tactic
method private updated () =
match edited with
| None -> ()
- | Some { process ; composer ; browser ; target } ->
- self#select ~process ~composer ~browser target
+ | Some { process ; composer ; browser ; target ; tree } ->
+ self#select ~process ~composer ~browser ~tree target
method clear =
begin
@@ -455,9 +460,11 @@ class tactic
try tac#select (self :> feedback) target
with Not_found | Exit -> Not_applicable
- method select ~process ~browser ~composer (target : selection) =
+ method select ~process ~browser ~composer ~tree
+ (target : selection) =
begin
self#reset_dongle ;
+ edited <- Some { process ; composer ; browser ; target ; tree } ;
let status = self#status target in
match status , error with
| Not_applicable , _ ->
@@ -466,12 +473,10 @@ class tactic
self#set_action () ;
| Not_configured , _ | Applicable _ , true ->
self#set_visible true ;
- edited <- Some { process ; composer ; browser ; target } ;
self#set_status `DIALOG_WARNING ;
self#set_action () ;
| Applicable proc , false ->
self#set_visible true ;
- edited <- Some { process ; composer ; browser ; target } ;
self#set_status `APPLY ;
let callback () = process tac target proc in
self#set_action ~callback () ;
diff --git a/src/plugins/wp/GuiTactic.mli b/src/plugins/wp/GuiTactic.mli
index 9d777188182b05a2fc6ef19a4c5d64de17b974af..40b9f2cc2320a3783ac0a6c5ddb1343137ffe308 100644
--- a/src/plugins/wp/GuiTactic.mli
+++ b/src/plugins/wp/GuiTactic.mli
@@ -64,6 +64,7 @@ class tactic : Tactical.t -> (Format.formatter -> Tactical.selection -> unit) ->
process:(tactical -> selection -> process -> unit) ->
browser:(browser -> unit) ->
composer:(composer -> unit) ->
+ tree:ProofEngine.tree ->
selection -> unit
end
diff --git a/src/plugins/wp/Lang.ml b/src/plugins/wp/Lang.ml
index fdcb24f90acfb8076919647c8c0e87985d746fff..3051ed18a418894640df2e2d9e1f912d80a38a97 100644
--- a/src/plugins/wp/Lang.ml
+++ b/src/plugins/wp/Lang.ml
@@ -801,7 +801,9 @@ struct
else
match Context.get_opt context_pp with
| Some env -> Pretty.pp_term_env env fmt e
- | None -> Pretty.pp_term Pretty.empty fmt e
+ | None ->
+ let env = Pretty.known Pretty.empty (QED.vars e) in
+ Pretty.pp_term env fmt e
let pp_pred = pp_term
let pp_var fmt x = pp_term fmt (e_var x)
let pp_vars fmt xs =
@@ -998,3 +1000,24 @@ struct
end
(* -------------------------------------------------------------------------- *)
+(* --- Simplifier --- *)
+(* -------------------------------------------------------------------------- *)
+
+exception Contradiction
+
+class type simplifier =
+ object
+ method name : string
+ method copy : simplifier
+ method assume : F.pred -> unit
+ method target : F.pred -> unit
+ method fixpoint : unit
+ method infer : F.pred list
+
+ method simplify_exp : F.term -> F.term
+ method simplify_hyp : F.pred -> F.pred
+ method simplify_branch : F.pred -> F.pred
+ method simplify_goal : F.pred -> F.pred
+ end
+
+(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/Lang.mli b/src/plugins/wp/Lang.mli
index 4644a22391f0473387a54a6fad9ed2871a6d5e0a..e594b3720e9bce4b72f90903addb6f8e64f71e80 100644
--- a/src/plugins/wp/Lang.mli
+++ b/src/plugins/wp/Lang.mli
@@ -552,4 +552,33 @@ sig
end
+(** {2 Simplifiers} *)
+
+exception Contradiction
+
+class type simplifier =
+ object
+ method name : string
+ method copy : simplifier
+ method assume : F.pred -> unit
+ (** Assumes the hypothesis *)
+ method target : F.pred -> unit
+ (** Give the predicate that will be simplified later *)
+ method fixpoint : unit
+ (** Called after assuming hypothesis and knowing the goal *)
+ method infer : F.pred list
+ (** Add new hypotheses implied by the original hypothesis. *)
+
+ method simplify_exp : F.term -> F.term
+ (** Currently simplify an expression. *)
+ method simplify_hyp : F.pred -> F.pred
+ (** Currently simplify an hypothesis before assuming it. In any
+ case must return a weaker formula. *)
+ method simplify_branch : F.pred -> F.pred
+ (** Currently simplify a branch condition. In any case must return an
+ equivalent formula. *)
+ method simplify_goal : F.pred -> F.pred
+ (** Simplify the goal. In any case must return a stronger formula. *)
+ end
+
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/LogicBuiltins.ml b/src/plugins/wp/LogicBuiltins.ml
index 1e20d51a4afe8ec605a214a06beb1a050d16bfce..a34105fae018047c8194da662cbf79aa356b8e41 100644
--- a/src/plugins/wp/LogicBuiltins.ml
+++ b/src/plugins/wp/LogicBuiltins.ml
@@ -214,7 +214,7 @@ let add_logic ~source result name kinds ~library ?category ~link () =
let add_predicate ~source name kinds ~library ~link () =
let params = List.map skind kinds in
- let lfun = Lang.extern_fp ~library ~params ~link name in
+ let lfun = Lang.extern_fp ~library ~params ~link link.altergo in
register ~source name kinds (LFUN lfun)
let add_ctor ~source name kinds ~library ~link () =
diff --git a/src/plugins/wp/LogicSemantics.ml b/src/plugins/wp/LogicSemantics.ml
index 60c0efae3922f9f7c5b7ae12876965847cd93b65..8f0c5dd0358b15a7b63d478b793b41a13013ee51 100644
--- a/src/plugins/wp/LogicSemantics.ml
+++ b/src/plugins/wp/LogicSemantics.ml
@@ -579,7 +579,11 @@ struct
| L_cint _ ->
L.map Cint.to_integer (C.logic env t)
| L_integer -> C.logic env t
- | L_cfloat _|L_bool|L_pointer _|L_array _ ->
+ | L_cfloat f ->
+ L.map
+ (fun x -> Cmath.int_of_real (Cfloat.real_of_float f x))
+ (C.logic env t)
+ | L_bool|L_pointer _|L_array _ ->
Warning.error "@[Logic cast from (%a) to (%a) not implemented yet@]"
Printer.pp_logic_type src_ltype Printer.pp_logic_type Linteger
diff --git a/src/plugins/wp/Plang.ml b/src/plugins/wp/Plang.ml
index f30029ce0903908836e42493a77898f6631bbc9e..bc6277756c078987be36f7cf5b8b7946d6d57aed 100644
--- a/src/plugins/wp/Plang.ml
+++ b/src/plugins/wp/Plang.ml
@@ -109,12 +109,12 @@ class engine =
if -256 <= n && n <= 256 then
Format.pp_print_int fmt n
else
- raise Integer.Too_big
- with Integer.Too_big ->
+ raise Z.Overflow
+ with Z.Overflow ->
match iformat with
| `Dec -> Integer.pretty ~hexa:false fmt z
- | `Hex -> Integer.pp_hex ~sep:"." fmt z
- | `Bin -> Integer.pp_bin ~sep:"." fmt z
+ | `Hex -> Integer.pp_hex ~sep:"," fmt z
+ | `Bin -> Integer.pp_bin ~sep:"," fmt z
method pp_real fmt q =
match Q.classify q with
diff --git a/src/plugins/wp/ProofEngine.ml b/src/plugins/wp/ProofEngine.ml
index 6d2bca1144d0184eea2d63679675fa643615cccc..acc7f935ca2acbd308d663ba09ac3d3021ba8e5e 100644
--- a/src/plugins/wp/ProofEngine.ml
+++ b/src/plugins/wp/ProofEngine.ml
@@ -40,6 +40,7 @@ and script =
type tree = {
main : Wpo.t ; (* Main goal to be proved. *)
+ mutable pool : Lang.F.pool option ; (* Global pool variable *)
mutable saved : bool ; (* Saved on Disk. *)
mutable gid : int ; (* WPO goal numbering *)
mutable head : node option ; (* the current node *)
@@ -51,12 +52,15 @@ module PROOFS = Model.StaticGenerator(Wpo.S)
type key = Wpo.S.t
type data = tree
let name = "Wp.ProofEngine.Proofs"
- let compile main = {
- main ; gid = 0 ;
- head = None ;
- root = None ;
- saved = false ;
- }
+ let compile main =
+ ignore (Wpo.resolve main) ;
+ {
+ main ; gid = 0 ;
+ pool = None ;
+ head = None ;
+ root = None ;
+ saved = false ;
+ }
end)
let () = Wpo.on_remove PROOFS.remove
@@ -73,6 +77,14 @@ let get wpo =
let iter_all f ns = List.iter (fun (_,n) -> f n) ns
let map_all f ns = List.map (fun (k,n) -> k,f n) ns
+let pool tree =
+ match tree.pool with
+ | Some pool -> pool
+ | None ->
+ let _,sequent = Wpo.compute tree.main in
+ let pool = Lang.new_pool ~vars:(Conditions.vars_seq sequent) () in
+ tree.pool <- Some pool ; pool
+
(* -------------------------------------------------------------------------- *)
(* --- Constructors --- *)
(* -------------------------------------------------------------------------- *)
@@ -106,7 +118,7 @@ let saved t = t.saved
let set_saved t s = t.saved <- s
(* -------------------------------------------------------------------------- *)
-(* --- Indexing --- *)
+(* --- Walking --- *)
(* -------------------------------------------------------------------------- *)
let rec walk f node =
@@ -115,6 +127,26 @@ let rec walk f node =
| Tactic (_,children) -> iter_all (walk f) children
| Opened | Script _ -> f node
+let rec witer f node =
+ let proved = Wpo.is_proved node.goal in
+ if proved then f ~proved node else
+ match node.script with
+ | Tactic (_,children) -> iter_all (witer f) children
+ | Opened | Script _ -> f ~proved node
+
+let iteri f tree =
+ match tree.root with
+ | None -> ()
+ | Some r ->
+ let k = ref 0 in
+ walk (fun node -> f !k node ; incr k) r
+
+(* -------------------------------------------------------------------------- *)
+(* --- Consolidating --- *)
+(* -------------------------------------------------------------------------- *)
+
+let proved n = Wpo.is_proved n.goal
+
let pending n =
let k = ref 0 in
walk (fun _ -> incr k) n ; !k
@@ -123,22 +155,26 @@ let has_pending n =
try walk (fun _ -> raise Exit) n ; false
with Exit -> true
-let iteri f tree =
- match tree.root with
- | None -> ()
- | Some r ->
- let k = ref 0 in
- walk (fun node -> f !k node ; incr k) r
+let consolidate root =
+ let result = ref VCS.valid in
+ witer
+ (fun ~proved:_ node ->
+ let rs = List.map snd (Wpo.get_results node.goal) in
+ result := VCS.merge !result (VCS.best rs) ;
+ ) root ;
+ !result
-let validate ?(unknown=false) tree =
+let validate ?(incomplete=false) tree =
match tree.root with
| None -> ()
- | Some r ->
+ | Some root ->
if not (Wpo.is_proved tree.main) then
- if not (has_pending r) then
+ if incomplete then
+ let result = consolidate root in
+ Wpo.set_result tree.main VCS.Tactical result
+ else
+ if not (has_pending root) then
Wpo.set_result tree.main VCS.Tactical VCS.valid
- else if unknown then
- Wpo.set_result tree.main VCS.Tactical VCS.unknown
(* -------------------------------------------------------------------------- *)
(* --- Accessors --- *)
@@ -180,7 +216,6 @@ let status t : status =
`Pending (pending root)
-let proved n = Wpo.is_proved n.goal
let opened n = not (Wpo.is_proved n.goal)
let state n =
@@ -355,14 +390,11 @@ let anchor tree ?node () =
| Some n -> n
| None -> mk_root tree
-let commit ~resolve fork =
- let resolved (_,wp) =
- Wpo.is_proved wp || ( resolve && Wpo.resolve wp ) in
- let resolved , residual = List.partition resolved fork.Fork.goals in
- iter_all Wpo.remove resolved ;
+let commit fork =
+ List.iter (fun (_,wp) -> ignore (Wpo.resolve wp)) fork.Fork.goals ;
let tree = fork.Fork.tree in
let anchor = fork.Fork.anchor in
- let children = map_all (mk_tree_node ~tree ~anchor) residual in
+ let children = map_all (mk_tree_node ~tree ~anchor) fork.Fork.goals in
tree.saved <- false ;
anchor.script <- Tactic( fork.Fork.tactic , children ) ;
anchor , children
diff --git a/src/plugins/wp/ProofEngine.mli b/src/plugins/wp/ProofEngine.mli
index 5d6e1f26afcc9628b824c27f09dea0659fce7bb8..53299b7b63a39b8e710cc0ed309981adb6291dc0 100644
--- a/src/plugins/wp/ProofEngine.mli
+++ b/src/plugins/wp/ProofEngine.mli
@@ -31,7 +31,7 @@ val get : Wpo.t -> [ `Script | `Proof | `Saved | `None ]
val proof : main:Wpo.t -> tree
val reset : tree -> unit
val remove : Wpo.t -> unit
-val validate : ?unknown:bool -> tree -> unit
+val validate : ?incomplete:bool -> tree -> unit
(** Leaves are numbered from 0 to n-1 *)
@@ -40,6 +40,7 @@ type state = [ `Opened | `Proved | `Pending of int | `Script of int ]
type current = [ `Main | `Internal of node | `Leaf of int * node ]
type position = [ `Main | `Node of node | `Leaf of int ]
+val pool : tree -> Lang.F.pool
val saved : tree -> bool
val set_saved : tree -> bool -> unit
@@ -70,7 +71,7 @@ type fork
val anchor : tree -> ?node:node -> unit -> node
val fork : tree -> anchor:node -> ProofScript.jtactic -> Tactical.process -> fork
val iter : (Wpo.t -> unit) -> fork -> unit
-val commit : resolve:bool -> fork -> node * (string * node) list
+val commit : fork -> node * (string * node) list
val pretty : Format.formatter -> fork -> unit
val script : tree -> ProofScript.jscript
diff --git a/src/plugins/wp/ProofScript.ml b/src/plugins/wp/ProofScript.ml
index 2f5b986d29a6a3c94ff0e8905df5e92eb10cd5ef..9bc0cf1931a1ea4d1942d60313099e0e3b65e683 100644
--- a/src/plugins/wp/ProofScript.ml
+++ b/src/plugins/wp/ProofScript.ml
@@ -429,11 +429,12 @@ let configure jtactic sequent =
(* --- Console --- *)
(* -------------------------------------------------------------------------- *)
-class console ~title =
+class console ~pool ~title =
object
val mutable the_title = title
+ method pool : Lang.F.pool = pool
method interactive = false
method get_title = the_title
method set_title : 'a. 'a formatter =
diff --git a/src/plugins/wp/ProofScript.mli b/src/plugins/wp/ProofScript.mli
index 3d82fbe6cada5d69e5eeeed88bff6889ffd1b59e..aca4732eea85763555c4597783ed0c00ec910921 100644
--- a/src/plugins/wp/ProofScript.mli
+++ b/src/plugins/wp/ProofScript.mli
@@ -23,7 +23,7 @@
open Tactical
open Conditions
-class console : title:string -> Tactical.feedback
+class console : pool:Lang.F.pool -> title:string -> Tactical.feedback
type jscript = alternative list
and alternative = private
diff --git a/src/plugins/wp/ProverScript.ml b/src/plugins/wp/ProverScript.ml
index 199f8180f9e0678a76630cebc3c578bc76a4401c..3ccf4f59b6873a055a172ced0622f3e5ae6cfbbf 100644
--- a/src/plugins/wp/ProverScript.ml
+++ b/src/plugins/wp/ProverScript.ml
@@ -78,7 +78,9 @@ let jconfigure (console : #Tactical.feedback) jtactic goal =
end
let jfork tree ?node jtactic =
- let console = new ProofScript.console ~title:jtactic.header in
+ let console = new ProofScript.console
+ ~pool:(ProofEngine.pool tree)
+ ~title:jtactic.header in
try
let anchor = ProofEngine.anchor tree ?node () in
let goal = ProofEngine.goal anchor in
@@ -136,13 +138,13 @@ struct
let stuck env =
if not env.signaled then
begin
- ProofEngine.validate ~unknown:true env.tree ;
+ ProofEngine.validate ~incomplete:true env.tree ;
env.success (ProofEngine.main env.tree) None ;
env.signaled <- true ;
end
let validate ?(finalize=false) env =
- ProofEngine.validate ~unknown:true env.tree ;
+ ProofEngine.validate ~incomplete:true env.tree ;
if not env.signaled then
let wpo = ProofEngine.main env.tree in
let proved = Wpo.is_proved wpo in
@@ -297,7 +299,7 @@ and autosearch env ~depth node : bool Task.task =
| Some fork -> autofork env ~depth fork
and autofork env ~depth fork =
- let _,children = ProofEngine.commit ~resolve:true fork in
+ let _,children = ProofEngine.commit fork in
let pending = Env.pending env in
if pending > 0 then
begin
@@ -344,7 +346,7 @@ let rec crawl env on_child node = function
begin
match jfork (Env.tree env) ?node jtactic with
| None ->
- Wp_parameters.error
+ Wp_parameters.warning
"Script Error: can not apply '%s'@\n\
@[<hov 2>Params: %a@]@\n\
@[<hov 2>Select: %a@]@."
@@ -354,9 +356,12 @@ let rec crawl env on_child node = function
crawl env on_child node alternative
| Some fork ->
(*TODO: saveback forgiven script *)
- let _,children = ProofEngine.commit ~resolve:true fork in
+ let _,children = ProofEngine.commit fork in
reconcile children subscripts ;
- if children = [] then
+ let residual = List.filter
+ (fun (_,node) -> not (ProofEngine.proved node))
+ children in
+ if residual = [] then
Env.validate env
else
List.iter (fun (_,n) -> on_child n) children ;
@@ -373,8 +378,11 @@ let schedule job =
let rec process env node =
schedule
begin fun () ->
- let script = Priority.sort (ProofEngine.bound node) in
- crawl env (process env) (Some node) script
+ if ProofEngine.proved node then
+ ( Env.validate env ; Task.return () )
+ else
+ let script = Priority.sort (ProofEngine.bound node) in
+ crawl env (process env) (Some node) script
end
let task
diff --git a/src/plugins/wp/ProverSearch.ml b/src/plugins/wp/ProverSearch.ml
index d64e003cc1b4a06f50e3e9fe72c445f47aaa3036..cdd825cbe4aefaaf71992c28f4f1dbe917954e64 100644
--- a/src/plugins/wp/ProverSearch.ml
+++ b/src/plugins/wp/ProverSearch.ml
@@ -40,7 +40,9 @@ let configure (console : #Tactical.feedback) strategy =
| _ -> None
let fork tree anchor strategy =
- let console = new ProofScript.console ~title:strategy.tactical#title in
+ let console = new ProofScript.console
+ ~pool:(ProofEngine.pool tree)
+ ~title:strategy.tactical#title in
try
let model = ProofEngine.node_model anchor in
match Model.with_model model (configure console) strategy with
diff --git a/src/plugins/wp/TacChoice.ml b/src/plugins/wp/TacChoice.ml
index 3830bf76446d3bb1ef4dfe1ad3c208d963d634ae..76d57c2391060b0bb753e94e62758414c26252db 100644
--- a/src/plugins/wp/TacChoice.ml
+++ b/src/plugins/wp/TacChoice.ml
@@ -64,13 +64,13 @@ class absurd =
| Clause(Step s) ->
begin
match s.condition with
- | Have p | When p | Core p ->
+ | Have p | When p | Core p | Init p | Type p ->
let absurd seq =
let emp = Conditions.(step (Have F.p_true)) in
let seq = Conditions.replace ~at:s.id emp seq in
[ "Absurd" , (fst seq , F.p_not p) ]
in Applicable absurd
- | Init _ | Type _ | Branch _ | Either _ | State _ ->
+ | Branch _ | Either _ | State _ ->
Not_applicable
end
end
@@ -90,7 +90,7 @@ class contrapose =
| Clause(Step s) ->
begin
match s.condition with
- | Have p | When p | Core p ->
+ | Have p | When p | Core p | Init p | Type p ->
let contrapose (hs,goal) =
let descr = "Contrapose" in
let goal = F.p_not goal in
@@ -98,7 +98,7 @@ class contrapose =
let hs = Conditions.replace ~at:s.id goal (hs , F.p_false) in
[ "Contrapose" , (fst hs , F.p_not p) ]
in Applicable contrapose
- | Init _ | Type _ | Branch _ | Either _ | State _ ->
+ | Branch _ | Either _ | State _ ->
Not_applicable
end
diff --git a/src/plugins/wp/TacCompound.ml b/src/plugins/wp/TacCompound.ml
index 09df4884d9a6f336b4fb2dcbaf03c87d402593bd..b1d5ec14505728c285c8de0e4b529d72fdfd7380 100644
--- a/src/plugins/wp/TacCompound.ml
+++ b/src/plugins/wp/TacCompound.ml
@@ -116,8 +116,7 @@ let field a b f =
Pretty_utils.sfprintf "Field %a" Lang.Field.pretty f ,
F.p_equal (F.e_getfield a f) (F.e_getfield b f)
-let index vars tau =
- let pool = Lang.new_pool ~vars () in
+let index ~pool tau =
let x = F.fresh pool tau in
[x] , F.e_var x
@@ -126,14 +125,14 @@ let neq i j p = F.p_imply (F.p_neq i j) p
let get1 a k v = F.p_equal (F.e_get a k) v
let get2 a b k = F.p_equal (F.e_get a k) (F.e_get b k)
-let clause ~(vars : F.Vars.t) = function
+let clause ~pool = function
| Record(a,b,fs) -> List.map (field a b) fs
| Array1((a,i,u),b,t) ->
- let ks,k = index vars t in
+ let ks,k = index ~pool t in
[ "Updated" , get1 b i u ;
"Others" , F.p_forall ks (neq i k (get2 a b k)) ]
| Array2((a,i,u),(b,j,v),t) ->
- let ks,k = index vars t in
+ let ks,k = index ~pool t in
[ "Updated (both)" , eq i j (F.p_equal u v) ;
"Updated (left)" , neq i j (get1 a j v) ;
"Updated (right)" , neq i j (get1 b i u) ;
@@ -153,47 +152,47 @@ let kind = function Record _ -> "compound" | Array1 _ | Array2 _ -> "array"
let equality eq = if eq then "equality" else "dis-equality"
let process_expand (feedback : Tactical.feedback) ?at e =
- let vars = F.vars e in
+ let pool = feedback#pool in
let eq,cmp = get_compound_equality e in
feedback#set_title "Compound (%s)" (name eq) ;
feedback#set_descr "Expand %s %s" (kind cmp) (equality eq) ;
- let e' = (if eq then conj else disj) (clause ~vars cmp) in
+ let e' = (if eq then conj else disj) (clause ~pool cmp) in
let cases = [feedback#get_title,F.p_true,e,F.e_prop e'] in
Tactical.rewrite ?at cases
let process_have (feedback : Tactical.feedback) s =
+ let pool = feedback#pool in
let e = F.e_prop (Conditions.have s) in
- let vars = F.vars e in
let eq,cmp = get_compound_equality e in
if eq then
begin
feedback#set_title "Compound (eq)" ;
feedback#set_descr "Expand %s equality" (kind cmp) ;
- let cases = ["Compound (eq)",When (conj (clause ~vars cmp))] in
+ let cases = ["Compound (eq)",When (conj (clause ~pool cmp))] in
Tactical.replace ~at:s.id cases
end
else
begin
feedback#set_title "Compound (split)" ;
feedback#set_descr "Split %s dis-equality" (kind cmp) ;
- let cases = List.map negative (clause ~vars cmp) in
+ let cases = List.map negative (clause ~pool cmp) in
Tactical.replace ~at:s.id cases
end
let process_goal (feedback : Tactical.feedback) p =
+ let pool = feedback#pool in
let eq,cmp = get_compound_equality (F.e_prop p) in
- let vars = F.varsp p in
if eq then
begin
feedback#set_title "Compound (split)" ;
feedback#set_descr "Split %s equality" (kind cmp) ;
- Tactical.split (clause ~vars cmp) ;
+ Tactical.split (clause ~pool cmp) ;
end
else
begin
feedback#set_title "Compound (neq)" ;
feedback#set_descr "Expand compound dis-equality" ;
- let cases = ["Compound (neq)",disj (clause ~vars cmp)] in
+ let cases = ["Compound (neq)",disj (clause ~pool cmp)] in
Tactical.split cases
end
diff --git a/src/plugins/wp/TacCongruence.ml b/src/plugins/wp/TacCongruence.ml
index b59a7a2812042e786ec62ab27703787c46789d1b..b5d79cedfb2d663712e62579c31ff960797fc0a2 100644
--- a/src/plugins/wp/TacCongruence.ml
+++ b/src/plugins/wp/TacCongruence.ml
@@ -133,8 +133,8 @@ let rec compare cmp a b =
not Integer.(equal p zero) &&
not Integer.(equal q zero) ->
let g = Integer.pgcd (Integer.abs p) (Integer.abs q) in
- let ka = Integer.div p g in
- let kb = Integer.div q g in
+ let ka = Integer.e_div p g in
+ let kb = Integer.e_div q g in
compare_div cmp (F.e_times ka a) (F.e_times kb b) (F.e_zint g)
| QDIV(a,u) , QDIV(b,v) -> compare_ratio cmp a u b v
@@ -164,8 +164,8 @@ let rec equal eq a b =
not Integer.(equal p zero) &&
not Integer.(equal q zero) ->
let g = Integer.pgcd (Integer.abs p) (Integer.abs q) in
- let ka = Integer.div p g in
- let kb = Integer.div q g in
+ let ka = Integer.e_div p g in
+ let kb = Integer.e_div q g in
compare_div EQ (F.e_times ka a) (F.e_times kb b) (F.e_zint g)
| QDIV(a,u) , QDIV(b,v) -> eq_ratio eq a u b v
diff --git a/src/plugins/wp/TacHavoc.ml b/src/plugins/wp/TacHavoc.ml
index ee2bbd7b4f0a68a8dc0ef47e36276d0cc8c58161..9b7034cc30839c0ed07020faf82927db93ef5e96 100644
--- a/src/plugins/wp/TacHavoc.ml
+++ b/src/plugins/wp/TacHavoc.ml
@@ -30,62 +30,38 @@ module L = Qed.Logic
(* --- Havoc --- *)
(* -------------------------------------------------------------------------- *)
-let field,parameter =
- Tactical.composer
- ~id:"address"
- ~title:"Address"
- ~descr:"Access Outside the Assigned Range"
- ()
-
-let has_type t e =
- try F.Tau.equal t (F.typeof e)
- with Not_found -> false
-
-let match_havoc =
- let havoc m1 = function
- | L.Fun( f , [m_undef;m0;a;n] ) when f == MemTyped.f_havoc -> m1,(m_undef,m0,a,n)
- | _ -> raise Not_found
- in function
- | L.Eq (m,m') -> (try havoc m' (F.repr m) with | Not_found -> havoc m (F.repr m'))
- | _ -> raise Not_found
+let lookup_havoc e =
+ match F.repr e with
+ | L.Aget( m , p ) ->
+ begin
+ match F.repr m with
+ | L.Fun( f , [mr;m0;a;n] ) when f == MemTyped.f_havoc ->
+ Some( mr , m0 , a , n , p )
+ | _ -> None
+ end
+ | _ -> None
class havoc =
- object(self)
+ object
inherit Tactical.make ~id:"Wp.havoc"
~title:"Havoc"
~descr:"Go Through Assigns"
- ~params:[parameter]
+ ~params:[]
- method select feedback sel =
- match sel with
- | Clause(Step s) ->
- begin
- match s.condition with
- | Have p | When p ->
- let m1,(m_undef,m0,a,n) = match_havoc (F.e_expr p) in
- let tp = F.typeof a in
- feedback#update_field ~filter:(has_type tp) field ;
- let sel = self#get_field field in
- if not (Tactical.is_empty sel) then
- let ptr = Tactical.selected sel in
- if has_type tp ptr then
- let separated =
- F.p_call MemTyped.p_separated
- [ ptr ; F.e_int 1 ; a ; n ] in
- let equal_unassigned =
- F.p_equal (F.e_get m1 ptr) (F.e_get m0 ptr) in
- let equal_assigned =
- F.p_equal (F.e_get m1 ptr) (F.e_get m_undef ptr) in
- let process = Tactical.insert ~at:s.id
- [ "Havoc",F.p_if separated equal_unassigned equal_assigned ] in
- Applicable process
- else
- ( feedback#set_error "Not a pointer type" ;
- Not_configured )
- else Not_configured
- | _ -> Not_applicable
- end
- | _ -> Not_applicable
+ method select _feedback sel =
+ let at = Tactical.at sel in
+ let e = Tactical.selected sel in
+ match lookup_havoc e with
+ | None -> Not_applicable
+ | Some(mr,m0,a,n,p) ->
+ let separated =
+ F.p_call MemTyped.p_separated
+ [ p ; F.e_int 1 ; a ; n ] in
+ let process = Tactical.rewrite ?at [
+ "Unassigned" , separated , e , F.e_get m0 p ;
+ "Assigned" , F.p_not separated , e , F.e_get mr p ;
+ ] in
+ Applicable process
end
(* -------------------------------------------------------------------------- *)
@@ -219,14 +195,13 @@ class validity =
module Havoc =
struct
- let field = field
let tactical = Tactical.export (new havoc)
- let strategy ?(priority=1.0) ~havoc ~addr =
+ let strategy ?(priority=1.0) ~havoc =
Strategy.{
priority ;
tactical ;
selection = havoc ;
- arguments = [ arg field addr ] ;
+ arguments = [] ;
}
end
diff --git a/src/plugins/wp/TacHavoc.mli b/src/plugins/wp/TacHavoc.mli
index 2ed3b403e084164a16fa9ea0f55a31c736348048..4d25edb8d32541f47afe6bd960e9538d640e7cc5 100644
--- a/src/plugins/wp/TacHavoc.mli
+++ b/src/plugins/wp/TacHavoc.mli
@@ -27,10 +27,9 @@ open Strategy
module Havoc :
sig
- val field : selection field
val tactical : tactical
val strategy :
- ?priority:float -> havoc:selection -> addr:selection -> strategy
+ ?priority:float -> havoc:selection -> strategy
end
module Separated :
diff --git a/src/plugins/wp/TacInstance.ml b/src/plugins/wp/TacInstance.ml
index ea227ab18ef8b10f42a02a49126f5baadf28f2cd..42eb158d5697eca2e09a93203747c05981c8d863 100644
--- a/src/plugins/wp/TacInstance.ml
+++ b/src/plugins/wp/TacInstance.ml
@@ -53,7 +53,6 @@ type bindings = (F.var * selection) list
type env = {
binder : L.binder ;
feedback : Tactical.feedback ;
- pool : Lang.F.pool ;
mutable index : int ;
}
@@ -154,7 +153,7 @@ class instance =
bindings, F.e_imply hs property
| L.Bind(q,tau,phi) , fd :: fields when q = env.binder ->
env.index <- succ env.index ;
- let x = F.fresh env.pool tau in
+ let x = F.fresh env.feedback#pool tau in
let v = self#get_field fd in
let range = match tau with L.Int -> true | _ -> false in
let tooltip = fieldname ~range env.index x in
@@ -171,9 +170,7 @@ class instance =
let binder = match side with None -> L.Exists | Some _ -> L.Forall in
let lemma = F.e_prop p in
if has_binder binder lemma then
- let vars = F.vars lemma in
- let pool = Lang.new_pool ~vars () in
- let env = { index = 0 ; feedback ; binder ; pool } in
+ let env = { index = 0 ; feedback ; binder } in
let bindings,phi = self#wrap env lemma fields in
if List.exists (fun (_,v) -> not (Tactical.is_empty v)) bindings
then
diff --git a/src/plugins/wp/TacShift.ml b/src/plugins/wp/TacShift.ml
index 3da39d9bc4894348efa696e89c69ffc11a0fe336..fff37a69094cfad98a268ab90100b7834634d576 100644
--- a/src/plugins/wp/TacShift.ml
+++ b/src/plugins/wp/TacShift.ml
@@ -45,7 +45,7 @@ let select_op f =
let select_int n =
match F.repr n with
| Qed.Logic.Kint n ->
- (try Integer.to_int n with Integer.Too_big -> raise Not_found)
+ (try Integer.to_int n with Z.Overflow -> raise Not_found)
| _ -> raise Not_found
class shift =
diff --git a/src/plugins/wp/TacSplit.ml b/src/plugins/wp/TacSplit.ml
index 88f3a2ba4ea3185fb46ef4a3e3ef311d597566cb..ac7a8919053453092eab3ece478e1c4a66edc8e4 100644
--- a/src/plugins/wp/TacSplit.ml
+++ b/src/plugins/wp/TacSplit.ml
@@ -24,7 +24,7 @@ open Lang
module PartitionsQQ : sig
val destructs_qq :
- Lang.F.pred ->
+ Lang.F.pool ->
Qed.Logic.binder -> tau:Lang.F.QED.tau -> phi:Lang.F.QED.bind ->
Lang.F.Vars.t * Lang.F.QED.term
@@ -35,12 +35,7 @@ end
let dkey = Wp_parameters.register_category "tac_split_quantifiers" (* debugging key *)
let debug fmt = Wp_parameters.debug ~dkey fmt
- let destructs_qq p qq ~tau ~phi =
- let pool =
- let quant = F.e_prop p in
- let vars = Lang.F.vars quant in
- Lang.new_pool ~vars ()
- in
+ let destructs_qq pool qq ~tau ~phi =
let rec destructs_qq vars ~tau ~phi =
let open Qed.Logic in
let x = F.fresh pool tau in
@@ -217,7 +212,7 @@ class split =
let open Qed.Logic in
match Lang.F.e_expr p with
| Bind (Exists,tau,phi) -> begin
- let vars,q = PartitionsQQ.destructs_qq p Exists ~tau ~phi in
+ let vars,q = PartitionsQQ.destructs_qq feedback#pool Exists ~tau ~phi in
match Lang.F.repr q with
| If (c,p,q) ->
if F.Vars.is_empty (F.Vars.inter (F.vars c) vars) then
@@ -326,7 +321,7 @@ class split =
let open Qed.Logic in
match F.e_expr p with
| Bind (Forall,tau,phi) -> begin
- let vars,q = PartitionsQQ.destructs_qq p Forall ~tau ~phi in
+ let vars,q = PartitionsQQ.destructs_qq feedback#pool Forall ~tau ~phi in
match Lang.F.repr q with
| If (c,p,q) ->
if F.Vars.is_empty (F.Vars.inter (F.vars c) vars) then
diff --git a/src/plugins/wp/Tactical.ml b/src/plugins/wp/Tactical.ml
index d49794b6cb54b829f016cc0e45db5cb5c43fc9d8..8bfb88d4f40c115f861e642236f18c71dec6a6c4 100644
--- a/src/plugins/wp/Tactical.ml
+++ b/src/plugins/wp/Tactical.ml
@@ -107,7 +107,7 @@ let selected = function
| Compose code -> composed code
let get_int_z z =
- try Some (Integer.to_int z) with _ -> None
+ try Some (Integer.to_int z) with Z.Overflow -> None
let get_int = function
| Empty -> None
@@ -316,6 +316,7 @@ type 'a formatter = ('a,Format.formatter,unit) format -> 'a
class type feedback =
object
+ method pool : pool
method interactive : bool
method get_title : string
method has_error : bool
diff --git a/src/plugins/wp/Tactical.mli b/src/plugins/wp/Tactical.mli
index f501602f64a148c810dcb1e447c33a779389a02c..c135567fe9fe67191b949604a845248dc0b9f962 100644
--- a/src/plugins/wp/Tactical.mli
+++ b/src/plugins/wp/Tactical.mli
@@ -142,6 +142,9 @@ type 'a formatter = ('a,Format.formatter,unit) format -> 'a
class type feedback =
object
+ (** Global fresh variable pool *)
+ method pool : pool
+
(** Interactive mode.
If [false] the GUI is not activated.
Hence, detailed feedback is not reported to the user. *)
diff --git a/src/plugins/wp/VCS.ml b/src/plugins/wp/VCS.ml
index b343e24d20cc2adf85d9ac0559431dece966b38b..4be16e756bda25b1418b3aef15f9967490f62397 100644
--- a/src/plugins/wp/VCS.ml
+++ b/src/plugins/wp/VCS.ml
@@ -366,3 +366,32 @@ let compare p q =
let t = Pervasives.compare p.prover_time q.prover_time in
if t <> 0 then t else
Pervasives.compare p.solver_time q.solver_time
+
+let combine v1 v2 =
+ match v1 , v2 with
+ | Valid , Valid -> Valid
+ | Failed , _ | _ , Failed -> Failed
+ | Invalid , _ | _ , Invalid -> Invalid
+ | Timeout , _ | _ , Timeout -> Timeout
+ | Stepout , _ | _ , Stepout -> Stepout
+ | _ -> Unknown
+
+let merge r1 r2 =
+ let err = if r1.prover_errmsg <> "" then r1 else r2 in
+ {
+ verdict = combine r1.verdict r2.verdict ;
+ solver_time = max r1.solver_time r2.solver_time ;
+ prover_time = max r1.prover_time r2.prover_time ;
+ prover_steps = max r1.prover_steps r2.prover_steps ;
+ prover_depth = max r1.prover_depth r2.prover_depth ;
+ prover_errpos = err.prover_errpos ;
+ prover_errmsg = err.prover_errmsg ;
+ }
+
+let choose r1 r2 =
+ match is_valid r1 , is_valid r2 with
+ | true , false -> r1
+ | false , true -> r2
+ | _ -> if compare r1 r2 <= 0 then r1 else r2
+
+let best = List.fold_left choose no_result
diff --git a/src/plugins/wp/VCS.mli b/src/plugins/wp/VCS.mli
index 31bf3423feb10d9348c935eec2ebb1da760a911a..ef6079503fca60854d404d895996ca21489bd285 100644
--- a/src/plugins/wp/VCS.mli
+++ b/src/plugins/wp/VCS.mli
@@ -131,6 +131,9 @@ val pp_result : Format.formatter -> result -> unit
val pp_result_perf : Format.formatter -> result -> unit
val compare : result -> result -> int (* best is minimal *)
+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
diff --git a/src/plugins/wp/Vlist.ml b/src/plugins/wp/Vlist.ml
index 0f41386b7f696ae9ad8e59a6b8b908a7511ab2b0..40bdc019497d18bcfeca31652a95564ac9b475be 100644
--- a/src/plugins/wp/Vlist.ml
+++ b/src/plugins/wp/Vlist.ml
@@ -160,7 +160,7 @@ and get_nth_list k = function
let rewrite_nth s k =
match F.repr k with
| L.Kint z ->
- let k = try Integer.to_int z with _ -> raise Not_found in
+ let k = try Integer.to_int z with Z.Overflow -> raise Not_found in
if 0 <= k then get_nth k s else raise Not_found
| _ -> raise Not_found
diff --git a/src/plugins/wp/calculus.ml b/src/plugins/wp/calculus.ml
index 230dace2e5727c80212687e0b926520736b3ab67..8f5b282c90ddfb87b51d6bb32c75531ee6d662d3 100644
--- a/src/plugins/wp/calculus.ml
+++ b/src/plugins/wp/calculus.ml
@@ -438,7 +438,7 @@ module Cfg (W : Mcfg.S) = struct
then W.call_goal_precond wenv stmt kf args ~pre:(pre_goals) obj
else obj
- let wp_calls ((caller_kf, cfg, strategy, _, wenv)) res v stmt
+ let wp_calls ((_, cfg, strategy, _, wenv)) res v stmt
lval call args p_post p_exit
=
debug "[wp_calls] %a@." Cil2cfg.pp_call_type call;
@@ -451,18 +451,16 @@ module Cfg (W : Mcfg.S) = struct
wp_call_kf wenv cenv stmt lval kf args precond ~p_post ~p_exit
| Cil2cfg.Dynamic fct ->
let bhv = WpStrategy.behavior_name_of_strategy strategy in
- let calls = Dyncall.get ?bhv stmt in
- if calls = [] then
- wp_call_any wenv cenv ~p_post ~p_exit
- else
- let precond = R.is_pass1 res in
- let call kf =
- let wp = wp_call_kf wenv cenv stmt lval
- kf args precond ~p_post ~p_exit in
- kf , wp in
- let prop = Dyncall.property ~kf:caller_kf ?bhv ~stmt ~calls in
- let pid = WpPropId.mk_property prop in
- W.call_dynamic wenv stmt pid fct (List.map call calls)
+ match Dyncall.get ?bhv stmt with
+ | None -> wp_call_any wenv cenv ~p_post ~p_exit
+ | Some (prop,calls) ->
+ let precond = R.is_pass1 res in
+ let do_call kf =
+ let wp = wp_call_kf wenv cenv stmt lval
+ kf args precond ~p_post ~p_exit in
+ kf , wp in
+ let pid = WpPropId.mk_property prop in
+ W.call_dynamic wenv stmt pid fct (List.map do_call calls)
let wp_stmt wenv s obj = match s.skind with
| Return (r, _) -> W.return wenv s r obj
diff --git a/src/plugins/wp/cfgWP.ml b/src/plugins/wp/cfgWP.ml
index 604c97700aac03d1b923e498ff741cd4dd0383fb..7a9212ebaee5782462b178c33633f3b37741d27c 100644
--- a/src/plugins/wp/cfgWP.ml
+++ b/src/plugins/wp/cfgWP.ml
@@ -220,8 +220,6 @@ struct
| Some s -> S.add s vc.path in
let deps = match hpid with
| None -> [] | Some p -> [WpPropId.property_of_id p] in
- let descr = match hpid with
- | None -> descr | Some _ -> None in
let dset = List.fold_right D.add deps vc.deps in
let wrns = match warn with
| None -> vc.warn
@@ -461,7 +459,6 @@ struct
let add_hyp wenv (hpid,predicate) wp = in_wenv wenv wp
(fun env wp ->
- let descr = Pretty_utils.to_string WpPropId.pretty hpid in
let outcome = Warning.catch
~severe:false ~effect:"Skip hypothesis"
(L.pred `Negative env) predicate in
@@ -469,7 +466,7 @@ struct
| Warning.Result(warn,p) -> warn , [p]
| Warning.Failed warn -> warn , []
in
- let vcs = gmap (assume_vc ~hpid ~descr ~warn hs) wp.vcs in
+ let vcs = gmap (assume_vc ~hpid ~warn hs) wp.vcs in
{ wp with vcs = vcs })
let add_goal wenv (gpid,predicate) wp = in_wenv wenv wp
@@ -865,22 +862,20 @@ struct
(fun env wp ->
let shere = L.current env in
let sinit = L.mem_at env Clabels.init in
- let hyp = C.unchanged shere sinit v in
- let filter = true in
- let init = true in
- let descr = "Global Constant" in
- let vcs = gmap (assume_vc ~filter ~init ~descr [hyp]) wp.vcs in
- { wp with vcs = vcs })
+ let const_vc = assume_vc
+ ~init:true ~filter:true
+ ~descr:"Global Constant"
+ [C.unchanged shere sinit v]
+ in { wp with vcs = gmap const_vc wp.vcs })
let init wenv var init wp = in_wenv wenv wp
(fun env wp ->
let sigma = L.current env in
- let hyps = C.init ~sigma var init in
- let filter = true in
- let init = true in
- let descr = "Initializer" in
- let vcs = gmap (assume_vcs ~filter ~init ~descr hyps) wp.vcs in
- { wp with vcs = vcs })
+ let init_vc = assume_vcs
+ ~init:true ~filter:true
+ ~descr:"Initializer"
+ (C.init ~sigma var init)
+ in { wp with vcs = gmap init_vc wp.vcs })
(* -------------------------------------------------------------------------- *)
(* --- WP RULE : tag --- *)
@@ -893,48 +888,45 @@ struct
(* --- WP RULE : call dynamic --- *)
(* -------------------------------------------------------------------------- *)
- let call_instances sigma gpid fct calls vcs =
+ let call_pointer sigma fct =
let outcome = Warning.catch
~severe:true ~effect:"Degenerated goal"
(C.call sigma) fct in
- let warn,goal = match outcome with
- | Warning.Failed warn -> warn,F.p_false
- | Warning.Result(warn,floc) ->
- warn , F.p_any (C.instance_of floc) calls
+ match outcome with
+ | Warning.Failed warn -> warn,None
+ | Warning.Result(warn,floc) -> warn,Some floc
+
+ let call_instance_of gpid (warn,fopt) calls vcs =
+ let goal = match fopt with
+ | None -> F.p_false
+ | Some floc -> F.p_any (C.instance_of floc) calls
in add_vc (Gprop gpid) ~warn goal vcs
- let call_contract stmt sigma fptr (kf,wp) : vc Splitter.t Gmap.t =
+ let call_contract stmt sigma hpid (warn,fopt) (kf,wp) : vc Splitter.t Gmap.t =
let pa = join_with sigma wp.sigma in
let tag = Splitter.call stmt kf in
- let descr = Printf.sprintf "Instance of '%s'" (Kernel_function.get_name kf) in
- let instance_vc pa fptr vc =
- passify_vc pa
- begin match fptr with
- | None -> vc
- | Some(warn,floc) ->
- let hyp = C.instance_of floc kf in
- assume_vc ~stmt ~warn ~descr [hyp] vc
- end
+ let descr =
+ Printf.sprintf "Instance of '%s'" (Kernel_function.get_name kf) in
+ let instance_of vc =
+ let hyp = match fopt with
+ | None -> F.p_true
+ | Some floc -> C.instance_of floc kf
+ in assume_vc ~stmt ~warn ~descr ~hpid [hyp] vc
in
Gmap.map
(fun s ->
Splitter.map
- (instance_vc pa fptr)
+ (fun vc -> passify_vc pa (instance_of vc))
(Splitter.group tag merge_vcs s)
) wp.vcs
let call_dynamic wenv stmt gpid fct calls = L.in_frame wenv.frame
begin fun () ->
let sigma = Sigma.create () in
- let outcome = Warning.catch
- ~severe:false ~effect:"Ignored function pointer value"
- (C.call sigma) fct in
- let fptr = match outcome with
- | Warning.Failed _warn -> None
- | Warning.Result(warn,floc) -> Some(warn,floc) in
- let vcs_calls = List.map (call_contract stmt sigma fptr) calls in
+ let called = call_pointer sigma fct in
+ let vcs_calls = List.map (call_contract stmt sigma gpid called) calls in
let vcs = merge_all_vcs vcs_calls in
- let vcs = call_instances sigma gpid fct (List.map fst calls) vcs in
+ let vcs = call_instance_of gpid called (List.map fst calls) vcs in
let effects = List.fold_left
(fun es (_,wp) -> Eset.union es wp.effects) Eset.empty calls in
{ sigma = Some sigma ; vcs = vcs ; effects = effects }
@@ -1474,7 +1466,7 @@ struct
begin
Wp_parameters.feedback ~ontty:`Transient "Collecting checks" ;
Bag.iter
- (fun w -> ignore (Wpo.resolve w))
+ (fun w -> ignore (Wpo.reduce w))
!collection ;
Lang.F.Check.iter (add_qed_check collection m) ;
end
diff --git a/src/plugins/wp/doc/manual/wp_builtins.tex b/src/plugins/wp/doc/manual/wp_builtins.tex
index 8b4a2563ac94faa87c2ef0895be5eb693ffebdf0..a556ab01a823cbaf618c55adf9d5bf414628c671 100644
--- a/src/plugins/wp/doc/manual/wp_builtins.tex
+++ b/src/plugins/wp/doc/manual/wp_builtins.tex
@@ -235,6 +235,20 @@ polar coordinates. Definitions imported from the reference implementation of
%---------------------------------------------------------------------------------------------
+\vskip 1em
+\hrule
+\label{builtin-fpcmp}
+\paragraph{$\builtin{le\_float}(x,y)$, $\builtin{ge\_float}(x,y)$,
+$\builtin{lt\_float}(x,y)$, $\builtin{gt\_float}(x,y)$, $\builtin{eq\_float}(x,y)$,
+$\builtin{ne\_float}(x,y)$, $\builtin{le\_double}(x,y)$,
+$\builtin{ge\_double}(x,y)$, $\builtin{lt\_double}(x,y)$,
+$\builtin{gt\_double}(x,y)$, $\builtin{eq\_double}(x,y)$, and
+$\builtin{ne\_double}(x,y)$} for dealing with floating point
+comparisons. They are similar to comparisons over the real numbers if both
+$x$ and $y$ are finite, but obey IEEE semantics for infinities and NaNs
+
+%---------------------------------------------------------------------------------------------
+
\section{Custom Extensions}
As explained in Section~\ref{drivers}, it is possible to extend all the properties mentioned
diff --git a/src/plugins/wp/doc/manual/wp_plugin.tex b/src/plugins/wp/doc/manual/wp_plugin.tex
index 86bdae51f57dfe3abd6becd0515a2ac2005680b5..6d1d1a3a70cec1a9675a2c229b0f72e0ecacce18 100644
--- a/src/plugins/wp/doc/manual/wp_plugin.tex
+++ b/src/plugins/wp/doc/manual/wp_plugin.tex
@@ -916,7 +916,12 @@ weakest precondition calculus.
and it can generates a large number of verifications for structures
with many (nested) fields (defaults to \texttt{no}).
\item[\tt -wp-(no)-dynamic] handles calls \textit{via} function pointers
- (experimental, default is: \texttt{no}).
+ thanks to the dedicated \verb+@calls f1,...,fn+ code annotation.
+ For each call to a function pointer \texttt{fp}
+ in the instruction or block under the annotaion,
+ \texttt{fp} is required to belongs to the set \texttt{f1,\ldots,fn} and
+ a case analysis is performed with the contract of each provided function
+ (default is: \texttt{yes}).
\end{description}
\subsection{Trigger Generation}
diff --git a/src/plugins/wp/dyncall.ml b/src/plugins/wp/dyncall.ml
index 9abd9d6a833d8f352692f06832fe3eae47ee0ef5..b7ab106b39aefdc31e7a7be26f210d6bfb692f3d 100644
--- a/src/plugins/wp/dyncall.ml
+++ b/src/plugins/wp/dyncall.ml
@@ -67,7 +67,7 @@ let get_calls ecmd bhvs : (string * Kernel_function.t list) list =
let fs = ref [] in
List.iter
(function
- | _,cmd, _, Ext_terms ts when cmd = ecmd ->
+ | _,cmd, _, _, Ext_terms ts when cmd = ecmd ->
fs := !fs @ List.map get_call ts
| _ -> ())
bhv.Cil_types.b_extended ;
@@ -86,7 +86,7 @@ let pp_calls fmt calls =
module PInfo = struct let module_name = "Dyncall.Point" end
module Point = Datatype.Pair_with_collections(Datatype.String)(Stmt)(PInfo)
-module Calls = Datatype.List(Kernel_function)
+module Calls = Datatype.Pair(Property)(Datatype.List(Kernel_function))
module CInfo =
struct
let name = "Dyncall.CallPoints"
@@ -95,10 +95,14 @@ struct
end
module CallPoints = State_builder.Hashtbl(Point.Hashtbl)(Calls)(CInfo)
-let property ~kf ?bhv ~stmt ~calls =
- let fact = match bhv with
- | None -> Format.asprintf "@[<hov 2>calls%a@]" pp_calls calls
- | Some b -> Format.asprintf "@[<hov 2>for %s calls%a@]" b pp_calls calls
+let property ~kf ~bhv ~stmt calls =
+ let fact =
+ if bhv = Cil.default_behavior_name then
+ Format.asprintf "@[<hov 2>call point%a@]"
+ pp_calls calls
+ else
+ Format.asprintf "@[<hov 2>call point%a for %s@]"
+ pp_calls calls bhv
in
Property.(ip_other fact (OLStmt (kf,stmt)))
@@ -106,6 +110,11 @@ let property ~kf ?bhv ~stmt ~calls =
(* --- Detection --- *)
(* -------------------------------------------------------------------------- *)
+let emitter = Emitter.create "Wp.Dyncall"
+ [ Emitter.Property_status ]
+ ~correctness:[]
+ ~tuning:[ Wp_parameters.DynCall.parameter ]
+
class dyncall =
object(self)
inherit Visitor.frama_c_inplace
@@ -116,6 +125,9 @@ class dyncall =
method count = count
+ method private kf =
+ match self#current_kf with None -> assert false | Some kf -> kf
+
method private stmt =
match self#current_stmt with None -> assert false | Some stmt -> stmt
@@ -125,7 +137,8 @@ class dyncall =
method! vcode_annot ca =
match ca.annot_content with
- | Cil_types.AExtended (bhvs,_,(_, "calls", _,Ext_terms calls)) ->
+ | Cil_types.AExtended
+ (bhvs,_,((_,"calls",_,_,Ext_terms calls) as extended)) ->
if calls <> [] && (scope <> [] || not (Stack.is_empty block_calls))
then begin
let bhvs =
@@ -133,27 +146,38 @@ class dyncall =
| [] -> [ Cil.default_behavior_name ]
| bhvs -> bhvs
in
- let add_calls_info stmt =
+ let debug_calls bhv stmt kfs =
+ if Wp_parameters.has_dkey dkey_calls then
+ let source = snd (Stmt.loc stmt) in
+ if Cil.default_behavior_name = bhv then
+ Wp_parameters.result ~source
+ "@[<hov 2>Calls%a@]" pp_calls kfs
+ else
+ Wp_parameters.result ~source
+ "@[<hov 2>Calls (for %s)%a@]" bhv pp_calls kfs
+ in
+ let pool = ref [] in (* collect emitted properties *)
+ let add_calls_info kf stmt =
count <- succ count ;
List.iter
(fun bhv ->
let kfs = List.map get_call calls in
- begin
- if Wp_parameters.has_dkey dkey_calls then
- let source = snd (Stmt.loc stmt) in
- if Cil.default_behavior_name = bhv then
- Wp_parameters.result ~source
- "@[<hov 2>Calls%a@]" pp_calls kfs
- else
- Wp_parameters.result ~source
- "@[<hov 2>Calls (for %s)%a@]" bhv pp_calls kfs
- end;
- CallPoints.add (bhv,stmt) kfs)
+ debug_calls bhv stmt kfs ;
+ let prop = property ~kf ~bhv ~stmt kfs in
+ pool := prop :: !pool ;
+ CallPoints.add (bhv,stmt) (prop,kfs))
bhvs
in
- if scope <> [] then List.iter add_calls_info scope
- else
- List.iter add_calls_info (Stack.top block_calls)
+ let kf = self#kf in
+ List.iter
+ (add_calls_info kf)
+ (if scope <> [] then scope else Stack.top block_calls) ;
+ if !pool <> [] then
+ begin
+ let eloc = Property.ELStmt(kf,self#stmt) in
+ let annot = Property.ip_of_extended eloc extended in
+ Property_status.logical_consequence emitter annot !pool ;
+ end
end;
SkipChildren
| _ -> SkipChildren
@@ -192,39 +216,52 @@ class dyncall =
end
-let once = ref false
-
-let compute () =
- if not !once && Wp_parameters.DynCall.get () then
- begin
- once := true ;
- Wp_parameters.feedback "Computing dynamic calls." ;
- let d = new dyncall in
- Visitor .visitFramacFile (d :> Visitor.frama_c_visitor) (Ast.get()) ;
- let n = d#count in
- if n > 0 then
- Wp_parameters.feedback "Dynamic call(s): %d." n
- else
- Wp_parameters.feedback "No dynamic call."
- end
+let compute =
+ let compute () =
+ if Wp_parameters.DynCall.get () then
+ begin
+ Wp_parameters.feedback ~dkey:dkey_calls "Computing dynamic calls." ;
+ let d = new dyncall in
+ Visitor .visitFramacFile (d :> Visitor.frama_c_visitor) (Ast.get()) ;
+ let n = d#count in
+ if n > 0 then
+ Wp_parameters.feedback ~dkey:dkey_calls "Dynamic call(s): %d." n
+ else
+ Wp_parameters.feedback ~dkey:dkey_calls "No dynamic call."
+ end
+ in fst (State_builder.apply_once "Wp.Dyncall.compute"
+ [Ast.self ;
+ Wp_parameters.DynCall.self] compute)
(* -------------------------------------------------------------------------- *)
(* --- Registry --- *)
(* -------------------------------------------------------------------------- *)
-let get ?(bhv=Cil.default_behavior_name) stmt =
+let get ?bhv stmt =
compute () ;
- try CallPoints.find (bhv,stmt)
- with Not_found -> []
+ let get bhv =
+ try Some (CallPoints.find (bhv,stmt))
+ with Not_found -> None
+ in
+ match bhv with
+ | None -> get Cil.default_behavior_name
+ | Some bhv ->
+ (match get bhv with
+ | None -> get Cil.default_behavior_name
+ | result -> result)
(* -------------------------------------------------------------------------- *)
(* --- Registry --- *)
(* -------------------------------------------------------------------------- *)
-let register () =
- if Wp_parameters.DynCall.get () then begin
- Logic_typing.register_code_annot_next_stmt_extension "calls" typecheck;
- Logic_typing.register_behavior_extension "instanceof" typecheck ;
- end
+let register =
+ let once = ref false in
+ fun () ->
+ if (not !once) &&
+ Wp_parameters.DynCall.get () then begin
+ once := true;
+ Logic_typing.register_code_annot_next_stmt_extension "calls" true typecheck;
+ Logic_typing.register_behavior_extension "instanceof" true typecheck ;
+ end
let () = Cmdline.run_after_configuring_stage register
diff --git a/src/plugins/wp/dyncall.mli b/src/plugins/wp/dyncall.mli
index 497ee779a18d1d20888416b69fd33fae4161988e..bbfa1440e239925699d545652d93d792669ff5df 100644
--- a/src/plugins/wp/dyncall.mli
+++ b/src/plugins/wp/dyncall.mli
@@ -24,12 +24,8 @@ open Cil_types
val pp_calls : Format.formatter -> kernel_function list -> unit
-val property : kf:kernel_function -> ?bhv:string -> stmt:stmt ->
- calls:kernel_function list -> Property.t
-(** Returns an property identifier for the precondition. *)
-
-val get : ?bhv:string -> stmt -> kernel_function list
-(** Returns empty list if there is no specified dynamic call. *)
+val get : ?bhv:string -> stmt -> (Property.t * kernel_function list) option
+(** Returns [None] if there is no specified dynamic call. *)
val compute : unit -> unit
(** Forces computation of dynamic calls.
diff --git a/src/plugins/wp/prover.ml b/src/plugins/wp/prover.ml
index 4de85cbcd9ab13a9ffdbc5ed2c8f883adcdd26d3..bc18054056ee79ce17a0b201df3c98f2e3c78cb5 100644
--- a/src/plugins/wp/prover.ml
+++ b/src/plugins/wp/prover.ml
@@ -76,7 +76,7 @@ let simplify ?start ?result wpo =
VCS.( r.verdict == Valid ) ||
begin
started ?start wpo ;
- if resolve wpo then
+ if Wpo.reduce wpo then
let time = qed_time wpo in
let res = VCS.result ~time VCS.Valid in
(update ?result wpo VCS.Qed res ; true)
diff --git a/src/plugins/wp/register.ml b/src/plugins/wp/register.ml
index ae5dcd02429cb933efa456d8861aebe6664703c3..dbb0bcfefa3cd1cc8b0ca355235d751a04ea682f 100644
--- a/src/plugins/wp/register.ml
+++ b/src/plugins/wp/register.ml
@@ -168,10 +168,6 @@ let pp_warnings fmt wpo =
| false , _ -> Format.fprintf fmt " (Stronger, %d warnings)" n
end
-let auto_check = function
- | { Wpo.po_formula = Wpo.GoalCheck _ } -> true
- | _ -> false
-
let launch task =
let server = ProverTask.server () in
(** Do on_server_stop save why3 session *)
@@ -359,7 +355,7 @@ let do_wpo_success goal s =
end
end
| Some prover ->
- if not (auto_check goal) then
+ if not (Wpo.is_check goal) then
Wp_parameters.feedback ~ontty:`Silent
"[%a] Goal %s : Valid" VCS.pp_prover prover (Wpo.get_gid goal)
diff --git a/src/plugins/wp/share/src/logs/Cbits.coq_BACKUP_6706.err b/src/plugins/wp/share/src/logs/Cbits.coq_BACKUP_6706.err
deleted file mode 100644
index fb2d1d57a8f4d66263b04e818b12a116c91cc100..0000000000000000000000000000000000000000
--- a/src/plugins/wp/share/src/logs/Cbits.coq_BACKUP_6706.err
+++ /dev/null
@@ -1,400 +0,0 @@
-<<<<<<< HEAD
-[Config] reading extra configuration file realization.conf
-File "SHARE/./qed.why", line 79, characters 8-19:
-warning: axiom c_euclidian does not contain any local abstract symbol
-File "SHARE/./qed.why", line 94, characters 8-22:
-warning: axiom cmod_remainder does not contain any local abstract symbol
-File "SHARE/./qed.why", line 100, characters 8-20:
-warning: axiom cdiv_neutral does not contain any local abstract symbol
-File "SHARE/./qed.why", line 101, characters 8-16:
-warning: axiom cdiv_inv does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 33, characters 8-15:
-warning: axiom abs_def does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 37, characters 8-17:
-warning: axiom sqrt_lin1 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 38, characters 8-17:
-warning: axiom sqrt_lin0 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 39, characters 8-14:
-warning: axiom sqrt_0 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 40, characters 8-14:
-warning: axiom sqrt_1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 37, characters 8-20:
-warning: axiom bit_test_def does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 44, characters 8-27:
-warning: axiom bit_test_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 50, characters 8-15:
-warning: axiom lsl_1_0 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 52, characters 8-31:
-warning: axiom bit_test_extraction_bis does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 54, characters 8-34:
-warning: axiom bit_test_extraction_bis_eq does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 59, characters 8-23:
-warning: axiom lnot_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 65, characters 8-23:
-warning: axiom land_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 71, characters 8-22:
-warning: axiom lor_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 77, characters 8-23:
-warning: axiom lxor_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 85, characters 8-20:
-warning: axiom land_1_lsl_1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 90, characters 8-26:
-warning: axiom lsl_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 96, characters 8-26:
-warning: axiom lsl_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 102, characters 8-23:
-warning: axiom lsr_extractionl does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 108, characters 8-23:
-warning: axiom lsl1_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 139, characters 8-31:
-warning: axiom to_uint8_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 144, characters 8-31:
-warning: axiom to_uint8_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 155, characters 8-32:
-warning: axiom to_uint16_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 160, characters 8-32:
-warning: axiom to_uint16_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 171, characters 8-32:
-warning: axiom to_uint32_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 176, characters 8-32:
-warning: axiom to_uint32_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 187, characters 8-32:
-warning: axiom to_uint64_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 192, characters 8-32:
-warning: axiom to_uint64_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 219, characters 8-31:
-warning: axiom to_sint8_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 224, characters 8-31:
-warning: axiom to_sint8_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 235, characters 8-32:
-warning: axiom to_sint16_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 240, characters 8-32:
-warning: axiom to_sint16_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 251, characters 8-32:
-warning: axiom to_sint32_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 256, characters 8-32:
-warning: axiom to_sint32_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 267, characters 8-32:
-warning: axiom to_sint64_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 272, characters 8-32:
-warning: axiom to_sint64_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 299, characters 8-21:
-warning: axiom to_uint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 329, characters 8-21:
-warning: axiom is_uint8_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 332, characters 8-20:
-warning: axiom is_uint8_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 335, characters 8-21:
-warning: axiom is_uint8_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 338, characters 8-20:
-warning: axiom is_uint8_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 341, characters 8-25:
-warning: axiom is_uint8_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 344, characters 8-25:
-warning: axiom is_uint8_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 348, characters 8-22:
-warning: axiom is_uint16_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 351, characters 8-21:
-warning: axiom is_uint16_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 354, characters 8-22:
-warning: axiom is_uint16_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 357, characters 8-21:
-warning: axiom is_uint16_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 360, characters 8-26:
-warning: axiom is_uint16_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 363, characters 8-26:
-warning: axiom is_uint16_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 367, characters 8-22:
-warning: axiom is_uint32_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 370, characters 8-21:
-warning: axiom is_uint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 373, characters 8-22:
-warning: axiom is_uint32_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 376, characters 8-21:
-warning: axiom is_uint32_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 379, characters 8-26:
-warning: axiom is_uint32_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 382, characters 8-26:
-warning: axiom is_uint32_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 386, characters 8-22:
-warning: axiom is_uint64_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 389, characters 8-21:
-warning: axiom is_uint64_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 392, characters 8-22:
-warning: axiom is_uint64_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 395, characters 8-21:
-warning: axiom is_uint64_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 398, characters 8-26:
-warning: axiom is_uint64_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 401, characters 8-26:
-warning: axiom is_uint64_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 428, characters 8-21:
-warning: axiom is_sint8_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 431, characters 8-21:
-warning: axiom is_sint8_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 434, characters 8-20:
-warning: axiom is_sint8_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 437, characters 8-21:
-warning: axiom is_sint8_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 440, characters 8-20:
-warning: axiom is_sint8_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 443, characters 8-21:
-warning: axiom is_sint8_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 446, characters 8-25:
-warning: axiom is_sint8_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 449, characters 8-25:
-warning: axiom is_sint8_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 453, characters 8-22:
-warning: axiom is_sint16_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 456, characters 8-22:
-warning: axiom is_sint16_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 459, characters 8-21:
-warning: axiom is_sint16_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 462, characters 8-22:
-warning: axiom is_sint16_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 465, characters 8-21:
-warning: axiom is_sint16_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 468, characters 8-22:
-warning: axiom is_sint16_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 471, characters 8-26:
-warning: axiom is_sint16_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 474, characters 8-26:
-warning: axiom is_sint16_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 478, characters 8-22:
-warning: axiom is_sint32_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 481, characters 8-22:
-warning: axiom is_sint32_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 484, characters 8-21:
-warning: axiom is_sint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 487, characters 8-22:
-warning: axiom is_sint32_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 490, characters 8-21:
-warning: axiom is_sint32_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 493, characters 8-22:
-warning: axiom is_sint32_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 496, characters 8-26:
-warning: axiom is_sint32_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 499, characters 8-26:
-warning: axiom is_sint32_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 503, characters 8-22:
-warning: axiom is_sint64_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 506, characters 8-22:
-warning: axiom is_sint64_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 509, characters 8-21:
-warning: axiom is_sint64_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 512, characters 8-22:
-warning: axiom is_sint64_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 515, characters 8-21:
-warning: axiom is_sint64_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 518, characters 8-22:
-warning: axiom is_sint64_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 521, characters 8-26:
-warning: axiom is_sint64_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 524, characters 8-26:
-warning: axiom is_sint64_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 549, characters 8-20:
-warning: axiom lor_addition does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 552, characters 8-21:
-warning: axiom lxor_addition does not contain any local abstract symbol
-||||||| merged common ancestors
-=======
-[Config] reading extra configuration file realization.conf
-File "WP-SHARE/src/./qed.why", line 76, characters 8-19:
-warning: axiom c_euclidian does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 91, characters 8-22:
-warning: axiom cmod_remainder does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 97, characters 8-20:
-warning: axiom cdiv_neutral does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 98, characters 8-16:
-warning: axiom cdiv_inv does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 32, characters 8-15:
-warning: axiom abs_def does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 43, characters 8-17:
-warning: axiom sqrt_lin1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 44, characters 8-17:
-warning: axiom sqrt_lin0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 45, characters 8-14:
-warning: axiom sqrt_0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 46, characters 8-14:
-warning: axiom sqrt_1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 55, characters 8-15:
-warning: axiom exp_pos does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 37, characters 8-20:
-warning: axiom bit_test_def does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 44, characters 8-27:
-warning: axiom bit_test_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 50, characters 8-15:
-warning: axiom lsl_1_0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 52, characters 8-31:
-warning: axiom bit_test_extraction_bis does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 54, characters 8-34:
-warning: axiom bit_test_extraction_bis_eq does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 59, characters 8-23:
-warning: axiom lnot_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 65, characters 8-23:
-warning: axiom land_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 71, characters 8-22:
-warning: axiom lor_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 77, characters 8-23:
-warning: axiom lxor_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 85, characters 8-20:
-warning: axiom land_1_lsl_1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 90, characters 8-26:
-warning: axiom lsl_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 96, characters 8-26:
-warning: axiom lsl_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 102, characters 8-23:
-warning: axiom lsr_extractionl does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 108, characters 8-23:
-warning: axiom lsl1_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 139, characters 8-31:
-warning: axiom to_uint8_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 144, characters 8-31:
-warning: axiom to_uint8_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 155, characters 8-32:
-warning: axiom to_uint16_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 160, characters 8-32:
-warning: axiom to_uint16_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 171, characters 8-32:
-warning: axiom to_uint32_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 176, characters 8-32:
-warning: axiom to_uint32_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 187, characters 8-32:
-warning: axiom to_uint64_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 192, characters 8-32:
-warning: axiom to_uint64_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 219, characters 8-31:
-warning: axiom to_sint8_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 224, characters 8-31:
-warning: axiom to_sint8_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 235, characters 8-32:
-warning: axiom to_sint16_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 240, characters 8-32:
-warning: axiom to_sint16_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 251, characters 8-32:
-warning: axiom to_sint32_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 256, characters 8-32:
-warning: axiom to_sint32_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 267, characters 8-32:
-warning: axiom to_sint64_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 272, characters 8-32:
-warning: axiom to_sint64_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 299, characters 8-21:
-warning: axiom to_uint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 329, characters 8-21:
-warning: axiom is_uint8_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 332, characters 8-20:
-warning: axiom is_uint8_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 335, characters 8-21:
-warning: axiom is_uint8_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 338, characters 8-20:
-warning: axiom is_uint8_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 341, characters 8-25:
-warning: axiom is_uint8_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 344, characters 8-25:
-warning: axiom is_uint8_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 348, characters 8-22:
-warning: axiom is_uint16_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 351, characters 8-21:
-warning: axiom is_uint16_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 354, characters 8-22:
-warning: axiom is_uint16_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 357, characters 8-21:
-warning: axiom is_uint16_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 360, characters 8-26:
-warning: axiom is_uint16_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 363, characters 8-26:
-warning: axiom is_uint16_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 367, characters 8-22:
-warning: axiom is_uint32_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 370, characters 8-21:
-warning: axiom is_uint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 373, characters 8-22:
-warning: axiom is_uint32_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 376, characters 8-21:
-warning: axiom is_uint32_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 379, characters 8-26:
-warning: axiom is_uint32_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 382, characters 8-26:
-warning: axiom is_uint32_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 386, characters 8-22:
-warning: axiom is_uint64_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 389, characters 8-21:
-warning: axiom is_uint64_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 392, characters 8-22:
-warning: axiom is_uint64_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 395, characters 8-21:
-warning: axiom is_uint64_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 398, characters 8-26:
-warning: axiom is_uint64_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 401, characters 8-26:
-warning: axiom is_uint64_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 428, characters 8-21:
-warning: axiom is_sint8_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 431, characters 8-21:
-warning: axiom is_sint8_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 434, characters 8-20:
-warning: axiom is_sint8_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 437, characters 8-21:
-warning: axiom is_sint8_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 440, characters 8-20:
-warning: axiom is_sint8_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 443, characters 8-21:
-warning: axiom is_sint8_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 446, characters 8-25:
-warning: axiom is_sint8_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 449, characters 8-25:
-warning: axiom is_sint8_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 453, characters 8-22:
-warning: axiom is_sint16_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 456, characters 8-22:
-warning: axiom is_sint16_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 459, characters 8-21:
-warning: axiom is_sint16_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 462, characters 8-22:
-warning: axiom is_sint16_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 465, characters 8-21:
-warning: axiom is_sint16_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 468, characters 8-22:
-warning: axiom is_sint16_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 471, characters 8-26:
-warning: axiom is_sint16_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 474, characters 8-26:
-warning: axiom is_sint16_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 478, characters 8-22:
-warning: axiom is_sint32_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 481, characters 8-22:
-warning: axiom is_sint32_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 484, characters 8-21:
-warning: axiom is_sint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 487, characters 8-22:
-warning: axiom is_sint32_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 490, characters 8-21:
-warning: axiom is_sint32_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 493, characters 8-22:
-warning: axiom is_sint32_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 496, characters 8-26:
-warning: axiom is_sint32_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 499, characters 8-26:
-warning: axiom is_sint32_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 503, characters 8-22:
-warning: axiom is_sint64_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 506, characters 8-22:
-warning: axiom is_sint64_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 509, characters 8-21:
-warning: axiom is_sint64_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 512, characters 8-22:
-warning: axiom is_sint64_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 515, characters 8-21:
-warning: axiom is_sint64_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 518, characters 8-22:
-warning: axiom is_sint64_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 521, characters 8-26:
-warning: axiom is_sint64_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 524, characters 8-26:
-warning: axiom is_sint64_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 549, characters 8-20:
-warning: axiom lor_addition does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 552, characters 8-21:
-warning: axiom lxor_addition does not contain any local abstract symbol
->>>>>>> master
diff --git a/src/plugins/wp/share/src/logs/Cbits.coq_BASE_6706.err b/src/plugins/wp/share/src/logs/Cbits.coq_BASE_6706.err
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/src/plugins/wp/share/src/logs/Cbits.coq_LOCAL_6706.err b/src/plugins/wp/share/src/logs/Cbits.coq_LOCAL_6706.err
deleted file mode 100644
index bbdad5a73c9d8255f18628f6eec72fe43b1a5a22..0000000000000000000000000000000000000000
--- a/src/plugins/wp/share/src/logs/Cbits.coq_LOCAL_6706.err
+++ /dev/null
@@ -1,197 +0,0 @@
-[Config] reading extra configuration file realization.conf
-File "SHARE/./qed.why", line 79, characters 8-19:
-warning: axiom c_euclidian does not contain any local abstract symbol
-File "SHARE/./qed.why", line 94, characters 8-22:
-warning: axiom cmod_remainder does not contain any local abstract symbol
-File "SHARE/./qed.why", line 100, characters 8-20:
-warning: axiom cdiv_neutral does not contain any local abstract symbol
-File "SHARE/./qed.why", line 101, characters 8-16:
-warning: axiom cdiv_inv does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 33, characters 8-15:
-warning: axiom abs_def does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 37, characters 8-17:
-warning: axiom sqrt_lin1 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 38, characters 8-17:
-warning: axiom sqrt_lin0 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 39, characters 8-14:
-warning: axiom sqrt_0 does not contain any local abstract symbol
-File "SHARE/./cmath.why", line 40, characters 8-14:
-warning: axiom sqrt_1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 37, characters 8-20:
-warning: axiom bit_test_def does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 44, characters 8-27:
-warning: axiom bit_test_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 50, characters 8-15:
-warning: axiom lsl_1_0 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 52, characters 8-31:
-warning: axiom bit_test_extraction_bis does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 54, characters 8-34:
-warning: axiom bit_test_extraction_bis_eq does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 59, characters 8-23:
-warning: axiom lnot_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 65, characters 8-23:
-warning: axiom land_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 71, characters 8-22:
-warning: axiom lor_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 77, characters 8-23:
-warning: axiom lxor_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 85, characters 8-20:
-warning: axiom land_1_lsl_1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 90, characters 8-26:
-warning: axiom lsl_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 96, characters 8-26:
-warning: axiom lsl_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 102, characters 8-23:
-warning: axiom lsr_extractionl does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 108, characters 8-23:
-warning: axiom lsl1_extraction does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 139, characters 8-31:
-warning: axiom to_uint8_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 144, characters 8-31:
-warning: axiom to_uint8_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 155, characters 8-32:
-warning: axiom to_uint16_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 160, characters 8-32:
-warning: axiom to_uint16_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 171, characters 8-32:
-warning: axiom to_uint32_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 176, characters 8-32:
-warning: axiom to_uint32_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 187, characters 8-32:
-warning: axiom to_uint64_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 192, characters 8-32:
-warning: axiom to_uint64_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 219, characters 8-31:
-warning: axiom to_sint8_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 224, characters 8-31:
-warning: axiom to_sint8_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 235, characters 8-32:
-warning: axiom to_sint16_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 240, characters 8-32:
-warning: axiom to_sint16_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 251, characters 8-32:
-warning: axiom to_sint32_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 256, characters 8-32:
-warning: axiom to_sint32_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 267, characters 8-32:
-warning: axiom to_sint64_extraction_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 272, characters 8-32:
-warning: axiom to_sint64_extraction_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 299, characters 8-21:
-warning: axiom to_uint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 329, characters 8-21:
-warning: axiom is_uint8_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 332, characters 8-20:
-warning: axiom is_uint8_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 335, characters 8-21:
-warning: axiom is_uint8_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 338, characters 8-20:
-warning: axiom is_uint8_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 341, characters 8-25:
-warning: axiom is_uint8_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 344, characters 8-25:
-warning: axiom is_uint8_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 348, characters 8-22:
-warning: axiom is_uint16_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 351, characters 8-21:
-warning: axiom is_uint16_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 354, characters 8-22:
-warning: axiom is_uint16_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 357, characters 8-21:
-warning: axiom is_uint16_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 360, characters 8-26:
-warning: axiom is_uint16_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 363, characters 8-26:
-warning: axiom is_uint16_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 367, characters 8-22:
-warning: axiom is_uint32_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 370, characters 8-21:
-warning: axiom is_uint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 373, characters 8-22:
-warning: axiom is_uint32_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 376, characters 8-21:
-warning: axiom is_uint32_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 379, characters 8-26:
-warning: axiom is_uint32_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 382, characters 8-26:
-warning: axiom is_uint32_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 386, characters 8-22:
-warning: axiom is_uint64_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 389, characters 8-21:
-warning: axiom is_uint64_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 392, characters 8-22:
-warning: axiom is_uint64_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 395, characters 8-21:
-warning: axiom is_uint64_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 398, characters 8-26:
-warning: axiom is_uint64_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 401, characters 8-26:
-warning: axiom is_uint64_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 428, characters 8-21:
-warning: axiom is_sint8_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 431, characters 8-21:
-warning: axiom is_sint8_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 434, characters 8-20:
-warning: axiom is_sint8_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 437, characters 8-21:
-warning: axiom is_sint8_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 440, characters 8-20:
-warning: axiom is_sint8_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 443, characters 8-21:
-warning: axiom is_sint8_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 446, characters 8-25:
-warning: axiom is_sint8_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 449, characters 8-25:
-warning: axiom is_sint8_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 453, characters 8-22:
-warning: axiom is_sint16_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 456, characters 8-22:
-warning: axiom is_sint16_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 459, characters 8-21:
-warning: axiom is_sint16_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 462, characters 8-22:
-warning: axiom is_sint16_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 465, characters 8-21:
-warning: axiom is_sint16_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 468, characters 8-22:
-warning: axiom is_sint16_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 471, characters 8-26:
-warning: axiom is_sint16_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 474, characters 8-26:
-warning: axiom is_sint16_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 478, characters 8-22:
-warning: axiom is_sint32_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 481, characters 8-22:
-warning: axiom is_sint32_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 484, characters 8-21:
-warning: axiom is_sint32_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 487, characters 8-22:
-warning: axiom is_sint32_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 490, characters 8-21:
-warning: axiom is_sint32_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 493, characters 8-22:
-warning: axiom is_sint32_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 496, characters 8-26:
-warning: axiom is_sint32_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 499, characters 8-26:
-warning: axiom is_sint32_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 503, characters 8-22:
-warning: axiom is_sint64_lnot does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 506, characters 8-22:
-warning: axiom is_sint64_lxor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 509, characters 8-21:
-warning: axiom is_sint64_lor does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 512, characters 8-22:
-warning: axiom is_sint64_land does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 515, characters 8-21:
-warning: axiom is_sint64_lsr does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 518, characters 8-22:
-warning: axiom is_sint64_lsl1 does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 521, characters 8-26:
-warning: axiom is_sint64_lsl1_inf does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 524, characters 8-26:
-warning: axiom is_sint64_lsl1_sup does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 549, characters 8-20:
-warning: axiom lor_addition does not contain any local abstract symbol
-File "SHARE/./cbits.why", line 552, characters 8-21:
-warning: axiom lxor_addition does not contain any local abstract symbol
diff --git a/src/plugins/wp/share/src/logs/Cbits.coq_REMOTE_6706.err b/src/plugins/wp/share/src/logs/Cbits.coq_REMOTE_6706.err
deleted file mode 100644
index 0ef883890f35911f4abdc5a61b0d9dbaa48b22cf..0000000000000000000000000000000000000000
--- a/src/plugins/wp/share/src/logs/Cbits.coq_REMOTE_6706.err
+++ /dev/null
@@ -1,199 +0,0 @@
-[Config] reading extra configuration file realization.conf
-File "WP-SHARE/src/./qed.why", line 76, characters 8-19:
-warning: axiom c_euclidian does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 91, characters 8-22:
-warning: axiom cmod_remainder does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 97, characters 8-20:
-warning: axiom cdiv_neutral does not contain any local abstract symbol
-File "WP-SHARE/src/./qed.why", line 98, characters 8-16:
-warning: axiom cdiv_inv does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 32, characters 8-15:
-warning: axiom abs_def does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 43, characters 8-17:
-warning: axiom sqrt_lin1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 44, characters 8-17:
-warning: axiom sqrt_lin0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 45, characters 8-14:
-warning: axiom sqrt_0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 46, characters 8-14:
-warning: axiom sqrt_1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cmath.why", line 55, characters 8-15:
-warning: axiom exp_pos does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 37, characters 8-20:
-warning: axiom bit_test_def does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 44, characters 8-27:
-warning: axiom bit_test_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 50, characters 8-15:
-warning: axiom lsl_1_0 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 52, characters 8-31:
-warning: axiom bit_test_extraction_bis does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 54, characters 8-34:
-warning: axiom bit_test_extraction_bis_eq does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 59, characters 8-23:
-warning: axiom lnot_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 65, characters 8-23:
-warning: axiom land_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 71, characters 8-22:
-warning: axiom lor_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 77, characters 8-23:
-warning: axiom lxor_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 85, characters 8-20:
-warning: axiom land_1_lsl_1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 90, characters 8-26:
-warning: axiom lsl_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 96, characters 8-26:
-warning: axiom lsl_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 102, characters 8-23:
-warning: axiom lsr_extractionl does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 108, characters 8-23:
-warning: axiom lsl1_extraction does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 139, characters 8-31:
-warning: axiom to_uint8_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 144, characters 8-31:
-warning: axiom to_uint8_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 155, characters 8-32:
-warning: axiom to_uint16_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 160, characters 8-32:
-warning: axiom to_uint16_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 171, characters 8-32:
-warning: axiom to_uint32_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 176, characters 8-32:
-warning: axiom to_uint32_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 187, characters 8-32:
-warning: axiom to_uint64_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 192, characters 8-32:
-warning: axiom to_uint64_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 219, characters 8-31:
-warning: axiom to_sint8_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 224, characters 8-31:
-warning: axiom to_sint8_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 235, characters 8-32:
-warning: axiom to_sint16_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 240, characters 8-32:
-warning: axiom to_sint16_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 251, characters 8-32:
-warning: axiom to_sint32_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 256, characters 8-32:
-warning: axiom to_sint32_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 267, characters 8-32:
-warning: axiom to_sint64_extraction_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 272, characters 8-32:
-warning: axiom to_sint64_extraction_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 299, characters 8-21:
-warning: axiom to_uint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 329, characters 8-21:
-warning: axiom is_uint8_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 332, characters 8-20:
-warning: axiom is_uint8_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 335, characters 8-21:
-warning: axiom is_uint8_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 338, characters 8-20:
-warning: axiom is_uint8_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 341, characters 8-25:
-warning: axiom is_uint8_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 344, characters 8-25:
-warning: axiom is_uint8_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 348, characters 8-22:
-warning: axiom is_uint16_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 351, characters 8-21:
-warning: axiom is_uint16_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 354, characters 8-22:
-warning: axiom is_uint16_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 357, characters 8-21:
-warning: axiom is_uint16_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 360, characters 8-26:
-warning: axiom is_uint16_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 363, characters 8-26:
-warning: axiom is_uint16_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 367, characters 8-22:
-warning: axiom is_uint32_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 370, characters 8-21:
-warning: axiom is_uint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 373, characters 8-22:
-warning: axiom is_uint32_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 376, characters 8-21:
-warning: axiom is_uint32_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 379, characters 8-26:
-warning: axiom is_uint32_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 382, characters 8-26:
-warning: axiom is_uint32_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 386, characters 8-22:
-warning: axiom is_uint64_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 389, characters 8-21:
-warning: axiom is_uint64_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 392, characters 8-22:
-warning: axiom is_uint64_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 395, characters 8-21:
-warning: axiom is_uint64_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 398, characters 8-26:
-warning: axiom is_uint64_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 401, characters 8-26:
-warning: axiom is_uint64_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 428, characters 8-21:
-warning: axiom is_sint8_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 431, characters 8-21:
-warning: axiom is_sint8_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 434, characters 8-20:
-warning: axiom is_sint8_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 437, characters 8-21:
-warning: axiom is_sint8_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 440, characters 8-20:
-warning: axiom is_sint8_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 443, characters 8-21:
-warning: axiom is_sint8_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 446, characters 8-25:
-warning: axiom is_sint8_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 449, characters 8-25:
-warning: axiom is_sint8_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 453, characters 8-22:
-warning: axiom is_sint16_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 456, characters 8-22:
-warning: axiom is_sint16_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 459, characters 8-21:
-warning: axiom is_sint16_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 462, characters 8-22:
-warning: axiom is_sint16_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 465, characters 8-21:
-warning: axiom is_sint16_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 468, characters 8-22:
-warning: axiom is_sint16_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 471, characters 8-26:
-warning: axiom is_sint16_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 474, characters 8-26:
-warning: axiom is_sint16_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 478, characters 8-22:
-warning: axiom is_sint32_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 481, characters 8-22:
-warning: axiom is_sint32_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 484, characters 8-21:
-warning: axiom is_sint32_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 487, characters 8-22:
-warning: axiom is_sint32_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 490, characters 8-21:
-warning: axiom is_sint32_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 493, characters 8-22:
-warning: axiom is_sint32_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 496, characters 8-26:
-warning: axiom is_sint32_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 499, characters 8-26:
-warning: axiom is_sint32_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 503, characters 8-22:
-warning: axiom is_sint64_lnot does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 506, characters 8-22:
-warning: axiom is_sint64_lxor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 509, characters 8-21:
-warning: axiom is_sint64_lor does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 512, characters 8-22:
-warning: axiom is_sint64_land does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 515, characters 8-21:
-warning: axiom is_sint64_lsr does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 518, characters 8-22:
-warning: axiom is_sint64_lsl1 does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 521, characters 8-26:
-warning: axiom is_sint64_lsl1_inf does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 524, characters 8-26:
-warning: axiom is_sint64_lsl1_sup does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 549, characters 8-20:
-warning: axiom lor_addition does not contain any local abstract symbol
-File "WP-SHARE/src/./cbits.why", line 552, characters 8-21:
-warning: axiom lxor_addition does not contain any local abstract symbol
diff --git a/src/plugins/wp/tests/wp_acsl/float_compare.i b/src/plugins/wp/tests/wp_acsl/float_compare.i
new file mode 100644
index 0000000000000000000000000000000000000000..3e039b2cb13d4b139990011bfb807323d54d3c8f
--- /dev/null
+++ b/src/plugins/wp/tests/wp_acsl/float_compare.i
@@ -0,0 +1,23 @@
+/*@ lemma test_float_compare:
+ \forall float x,y;
+ \is_finite(x) && \is_finite(y) ==>
+ \le_float(x,y) ==> \lt_float(x,y) || \eq_float(x,y);
+*/
+
+/*@ lemma test_double_compare:
+ \forall double x,y;
+ \is_finite(x) && \is_finite(y) ==> \le_double(x,y) ==>
+ \lt_double(x,y) || \eq_double(x,y);
+*/
+
+/*@ lemma test_float_compare_greater:
+ \forall float x,y;
+ \is_finite(x) && \is_finite(y) ==>
+ \ge_float(x,y) ==> \gt_float(x,y) || \eq_float(x,y);
+*/
+
+/*@ lemma test_double_compare_greater:
+ \forall double x,y;
+ \is_finite(x) && \is_finite(y) ==> \ge_double(x,y) ==>
+ \gt_double(x,y) || \eq_double(x,y);
+*/
diff --git a/src/plugins/wp/tests/wp_acsl/float_compare.i.0.report.json b/src/plugins/wp/tests/wp_acsl/float_compare.i.0.report.json
new file mode 100644
index 0000000000000000000000000000000000000000..8ab9ce87bfcce6699c3d4d058f75fa169519f276
--- /dev/null
+++ b/src/plugins/wp/tests/wp_acsl/float_compare.i.0.report.json
@@ -0,0 +1,39 @@
+{ "wp:global": { "alt-ergo": { "total": 4, "valid": 4, "rank": 8 },
+ "wp:main": { "total": 4, "valid": 4, "rank": 8 } },
+ "wp:axiomatics": { "": { "lemma_test_float_compare_greater": { "alt-ergo":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 } },
+ "lemma_test_float_compare": { "alt-ergo":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 },
+ "wp:main": { "total": 1,
+ "valid": 1,
+ "rank": 8 } },
+ "lemma_test_double_compare_greater": { "alt-ergo":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 } },
+ "lemma_test_double_compare": { "alt-ergo":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 } },
+ "wp:section": { "alt-ergo": { "total": 4,
+ "valid": 4,
+ "rank": 8 },
+ "wp:main": { "total": 4,
+ "valid": 4,
+ "rank": 8 } } } } }
diff --git a/src/plugins/wp/tests/wp_acsl/oracle/classify_float.res.oracle b/src/plugins/wp/tests/wp_acsl/oracle/classify_float.res.oracle
index c376b86e98ce5ec321a21c7b88f978e7d29d847d..8ce615934da8264b474018856ccfe959b005583b 100644
--- a/src/plugins/wp/tests/wp_acsl/oracle/classify_float.res.oracle
+++ b/src/plugins/wp/tests/wp_acsl/oracle/classify_float.res.oracle
@@ -8,17 +8,17 @@
Lemma InfN_not_finite:
Assume: 'InfP_not_finite' 'NaN_not_finite'
-Prove: (not (\is_finite x_0)) \/ (not (\is_minus_infinity x_0))
+Prove: (not (is_finite_f64 x_0)) \/ (not (is_negative_infinite_f64 x_0))
------------------------------------------------------------
Lemma InfP_not_finite:
Assume: 'NaN_not_finite'
-Prove: (not (\is_finite x_0)) \/ (not (\is_plus_infinity x_0))
+Prove: (not (is_finite_f64 x_0)) \/ (not (is_positive_infinite_f64 x_0))
------------------------------------------------------------
Lemma NaN_not_finite:
-Prove: (not (\is_finite x_0)) \/ (not (\is_NaN x_0))
+Prove: (not (is_finite_f64 x_0)) \/ (not (is_NaN_f64 x_0))
------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_acsl/oracle/float_compare.res.oracle b/src/plugins/wp/tests/wp_acsl/oracle/float_compare.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..a31e1893ff76431ccf8b5d83313080b8d476d614
--- /dev/null
+++ b/src/plugins/wp/tests/wp_acsl/oracle/float_compare.res.oracle
@@ -0,0 +1,35 @@
+# frama-c -wp [...]
+[kernel] Parsing tests/wp_acsl/float_compare.i (no preprocessing)
+[wp] Running WP plugin...
+[wp] Loading driver 'share/wp.driver'
+------------------------------------------------------------
+ Global
+------------------------------------------------------------
+
+Lemma test_double_compare:
+Assume: 'test_float_compare'
+Prove: (is_finite_f64 x_0) -> (is_finite_f64 y_0) -> (le_f64 x_0 y_0)
+ -> ((eq_f64 x_0 y_0) \/ (lt_f64 x_0 y_0))
+
+------------------------------------------------------------
+
+Lemma test_double_compare_greater:
+Assume: 'test_float_compare_greater' 'test_double_compare'
+ 'test_float_compare'
+Prove: (is_finite_f64 x_0) -> (is_finite_f64 y_0) -> (le_f64 y_0 x_0)
+ -> ((eq_f64 x_0 y_0) \/ (lt_f64 y_0 x_0))
+
+------------------------------------------------------------
+
+Lemma test_float_compare:
+Prove: (is_finite_f32 x_0) -> (is_finite_f32 y_0) -> (le_f32 x_0 y_0)
+ -> ((eq_f32 x_0 y_0) \/ (lt_f32 x_0 y_0))
+
+------------------------------------------------------------
+
+Lemma test_float_compare_greater:
+Assume: 'test_double_compare' 'test_float_compare'
+Prove: (is_finite_f32 x_0) -> (is_finite_f32 y_0) -> (le_f32 y_0 x_0)
+ -> ((eq_f32 x_0 y_0) \/ (lt_f32 y_0 x_0))
+
+------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_acsl/oracle_qualif/float_compare.res.oracle b/src/plugins/wp/tests/wp_acsl/oracle_qualif/float_compare.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..828ad921cb7fc2d46ee73514a319c1d5d5330e5c
--- /dev/null
+++ b/src/plugins/wp/tests/wp_acsl/oracle_qualif/float_compare.res.oracle
@@ -0,0 +1,17 @@
+# frama-c -wp -wp-timeout 90 -wp-steps 1500 [...]
+[kernel] Parsing tests/wp_acsl/float_compare.i (no preprocessing)
+[wp] Running WP plugin...
+[wp] Loading driver 'share/wp.driver'
+[wp] 4 goals scheduled
+[wp] [Alt-Ergo] Goal typed_lemma_test_double_compare : Valid
+[wp] [Alt-Ergo] Goal typed_lemma_test_double_compare_greater : Valid
+[wp] [Alt-Ergo] Goal typed_lemma_test_float_compare : Valid
+[wp] [Alt-Ergo] Goal typed_lemma_test_float_compare_greater : Valid
+[wp] Proved goals: 4 / 4
+ Qed: 0
+ Alt-Ergo: 4
+[wp] Report 'tests/wp_acsl/float_compare.i.0.report.json'
+-------------------------------------------------------------
+Axiomatics WP Alt-Ergo Total Success
+Lemma - 4 (28..40) 4 100%
+-------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c b/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c
index 3b2f455462b87e1a1583e00411d232de30245661..c1946eee14500d6db0d7df208a37e2855406e974 100644
--- a/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c
+++ b/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c
@@ -3,30 +3,29 @@
*/
/* run.config_qualif
- OPT: -warn-unsigned-overflow -wp-prop=-lack -then -warn-unsigned-overflow -wp-rte -wp -wp-prop=-lack
+ OPT: -wp-prover why3:alt-ergo -warn-unsigned-overflow -wp-prop=-lack -then -warn-unsigned-overflow -wp-rte -wp -wp-prop=-lack
*/
typedef unsigned uint32_t ;
typedef unsigned long long uint64_t ;
/*@ axiomatic mult {
- @ lemma sizeof_uint32_t: ok: sizeof(uint32_t) == 4; // 4 bytes: 32 bits
- @ lemma sizeof_uint64_t: ok: sizeof(uint64_t) == 8; // 8 bytes: 64 bits
- @
- @ lemma ax1: lack: \forall integer x, y; 0<=x && 0< y ==> 0 <= x <= x*y;
- @ lemma ax2: lack: \forall integer x, y; 0<=x && 0<=y ==> 0 <= 2*x*(y/2) <= x*y;
+
+ @ lemma sizeof_ok: ok: sizeof(uint64_t) == 2 * sizeof(uint32_t);
+
+ @ lemma ax1: lack: \forall integer x, y; 0<x && 0<y ==> 0 <= 2*x*(y/2) <= x*y;
@ }
@ */
//@ ensures product: \result == a*b;
uint64_t BinaryMultiplication (uint32_t a, uint32_t b) {
- //@ assert a1: ok: deductible: a*b <= 18446744073709551615; // deductible from type size
+ //@ assert a1: ok: deductible: a*b <= 18446744073709551615; // deductible from size of C types
uint64_t r=0;
uint64_t x=a;
if (b != 0) {
/*@ loop assigns ok: r, x, b;
- @ loop invariant inv1: lack: r+x*b == \at(a*b, LoopEntry);
- @ loop invariant inv2: ok: deductible: 2*x*(b/2) <= 18446744073709551615; // deductible from inv1, ax2, ax1, a1 and x>=0, b>0, r>=0
+ @ loop invariant inv1: ok: r+x*b == \at(a*b, LoopEntry);
+ @ loop invariant inv2: ok: deductible: 2*x*(b/2) <= 18446744073709551615; // deductible from inv1, ax1, a1 and x>=0, b>0, r>=0
@ loop variant ok: b ;
@*/
while (1) {
diff --git a/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json b/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json
index e5cea006b893c57b97b6bce5b539a95158f1c2a9..fd14edb93a62ed85f22868b68e6d12c0ab84415b 100644
--- a/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json
+++ b/src/plugins/wp/tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json
@@ -1,89 +1,72 @@
-{ "wp:global": { "alt-ergo": { "total": 10, "valid": 10, "rank": 17 },
+{ "wp:global": { "why3:alt-ergo": { "total": 11, "valid": 11 },
"qed": { "total": 3, "valid": 3 },
- "wp:main": { "total": 13, "valid": 13, "rank": 17 } },
- "wp:axiomatics": { "mult": { "lemma_sizeof_uint64_t_ok": { "qed": { "total": 1,
- "valid": 1 },
- "wp:main":
- { "total": 1,
- "valid": 1 } },
- "lemma_sizeof_uint32_t_ok": { "qed": { "total": 1,
- "valid": 1 },
- "wp:main":
- { "total": 1,
- "valid": 1 } },
- "wp:section": { "qed": { "total": 2,
- "valid": 2 },
- "wp:main": { "total": 2,
- "valid": 2 } } } },
+ "wp:main": { "total": 14, "valid": 14 } },
+ "wp:axiomatics": { "mult": { "lemma_sizeof_ok_ok": { "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } },
+ "wp:section": { "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } } } },
"wp:functions": { "BinaryMultiplication": { "BinaryMultiplication_assert_rte_unsigned_overflow_4":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 6 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 6 } },
+ "valid": 1 } },
"BinaryMultiplication_assert_rte_unsigned_overflow_3":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 6 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 6 } },
+ "valid": 1 } },
"BinaryMultiplication_assert_rte_unsigned_overflow_2":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 10 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 10 } },
+ "valid": 1 } },
"BinaryMultiplication_assert_rte_unsigned_overflow":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 5 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 5 } },
+ "valid": 1 } },
"BinaryMultiplication_loop_invariant_inv2_ok_deductible":
- { "alt-ergo": { "total": 2,
- "valid": 2,
- "rank": 10 },
+ { "why3:alt-ergo": { "total": 2,
+ "valid": 2 },
"wp:main": { "total": 2,
- "valid": 2,
- "rank": 10 } },
+ "valid": 2 } },
+ "BinaryMultiplication_loop_invariant_inv1_ok":
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
+ "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 2,
+ "valid": 2 } },
"BinaryMultiplication_assert_a1_ok_deductible":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 3 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 3 } },
+ "valid": 1 } },
"BinaryMultiplication_loop_variant":
- { "alt-ergo": { "total": 2,
- "valid": 2,
- "rank": 8 },
+ { "why3:alt-ergo": { "total": 2,
+ "valid": 2 },
"wp:main": { "total": 2,
- "valid": 2,
- "rank": 8 } },
+ "valid": 2 } },
"BinaryMultiplication_loop_assigns":
{ "qed": { "total": 1,
"valid": 1 },
"wp:main": { "total": 1,
"valid": 1 } },
"BinaryMultiplication_ensures_product":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 16 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 16 } },
- "wp:section": { "alt-ergo":
- { "total": 10,
- "valid": 10,
- "rank": 17 },
+ "valid": 1 } },
+ "wp:section": { "why3:alt-ergo":
+ { "total": 11,
+ "valid": 11 },
"qed":
- { "total": 1,
- "valid": 1 },
+ { "total": 2,
+ "valid": 2 },
"wp:main":
- { "total": 11,
- "valid": 11,
- "rank": 17 } } } } }
+ { "total": 13,
+ "valid": 13 } } } } }
diff --git a/src/plugins/wp/tests/wp_gallery/binary-multiplication.c b/src/plugins/wp/tests/wp_gallery/binary-multiplication.c
index 08906aa5f7371a840eb06784a350d35311a40360..11732fd2cf5d647e279f21c7898b93f5d3fa6d7e 100644
--- a/src/plugins/wp/tests/wp_gallery/binary-multiplication.c
+++ b/src/plugins/wp/tests/wp_gallery/binary-multiplication.c
@@ -3,34 +3,33 @@
*/
/* run.config_qualif
- OPT: -wp-prop=-lack -then -wp-rte -wp -wp-prop=-lack
+ OPT: -wp-prover why3:alt-ergo -wp-prop=-lack -then -wp-rte -wp -wp-prop=-lack
*/
typedef unsigned uint32_t ;
typedef unsigned long long uint64_t ;
/*@ axiomatic mult {
- @ lemma sizeof_uint32_t: ok: sizeof(uint32_t) == 4; // 4 bytes: 32 bits
- @ lemma sizeof_uint64_t: ok: sizeof(uint64_t) == 8; // 8 bytes: 64 bits
- @
- @ lemma ax1: lack: \forall integer x, y; 0<=x && 0< y ==> 0 <= x <= x*y;
- @ lemma ax2: lack: \forall integer x, y; 0<=x && 0<=y ==> 0 <= 2*x*(y/2) <= x*y;
- @ lemma ax3: lack: \forall integer x, y; (uint64_t)(x * ((uint64_t)y)) == (uint64_t)(x*y) ;
- @ lemma ax4: lack: \forall integer x, y; (uint64_t)(x + ((uint64_t)y)) == (uint64_t)(x+y) ;
- @ lemma ax5: ok: \forall integer x, y; (uint64_t)(((uint64_t)x) * y) == (uint64_t)(x*y) ;
- @ lemma ax6: ok: \forall integer x, y; (uint64_t)(((uint64_t)x) + y) == (uint64_t)(x+y) ;
+ @ lemma sizeof_ok: ok: sizeof(uint64_t) == 2*sizeof(uint32_t);
+
+ @ lemma ax1: lack: \forall integer x, y; 0<x && 0<y ==> 0 <= 2*x*(y/2) <= x*y;
+
+ @ lemma ax2: lack: \forall integer x, y; (uint64_t)(x * ((uint64_t)y)) == (uint64_t)(x*y) ;
+ @ lemma ax3: lack: \forall integer x, y; (uint64_t)(x + ((uint64_t)y)) == (uint64_t)(x+y) ;
+ @ lemma ax4: ok: \forall integer x, y; (uint64_t)(((uint64_t)x) * y) == (uint64_t)(x*y) ;
+ @ lemma ax5: ok: \forall integer x, y; (uint64_t)(((uint64_t)x) + y) == (uint64_t)(x+y) ;
@ }
@ */
//@ ensures product: \result == a*b;
uint64_t BinaryMultiplication (uint32_t a, uint32_t b) {
- //@ assert a1: ok: deductible: a*b <= 18446744073709551615; // deductible from type size
+ //@ assert a1: ok: deductible: a*b <= 18446744073709551615; // deductible from size of C types
uint64_t r=0;
uint64_t x=a;
if (b != 0) {
/*@ loop assigns r, x, b;
- @ loop invariant inv1: lack: r+x*b == \at(a*b, LoopEntry);
- @ loop invariant inv2: lack: r+x == (uint64_t)(r+x);
+ @ loop invariant inv1: ok: r+x*b == \at(a*b, LoopEntry);
+ @ loop invariant inv2: ok: deductible: 2*x*(b/2) <= 18446744073709551615; // deductible from inv1, ax1, a1 and x>=0, b>0, r>=0
@ loop variant ok: b ;
@*/
while (1) {
diff --git a/src/plugins/wp/tests/wp_gallery/binary-multiplication.c.0.report.json b/src/plugins/wp/tests/wp_gallery/binary-multiplication.c.0.report.json
index c033820912ee4cc581d52e26d70abe6b30d842df..1323c0ee776d77f1effe6fb3a814c5a81632a111 100644
--- a/src/plugins/wp/tests/wp_gallery/binary-multiplication.c.0.report.json
+++ b/src/plugins/wp/tests/wp_gallery/binary-multiplication.c.0.report.json
@@ -1,84 +1,72 @@
-{ "wp:global": { "alt-ergo": { "total": 8, "valid": 8, "rank": 34 },
+{ "wp:global": { "why3:alt-ergo": { "total": 11, "valid": 11 },
"qed": { "total": 3, "valid": 3 },
- "wp:main": { "total": 11, "valid": 11, "rank": 34 } },
- "wp:axiomatics": { "mult": { "lemma_sizeof_uint64_t_ok": { "qed": { "total": 1,
+ "wp:main": { "total": 14, "valid": 14 } },
+ "wp:axiomatics": { "mult": { "lemma_sizeof_ok_ok": { "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } },
+ "lemma_ax5_ok": { "why3:alt-ergo": { "total": 1,
"valid": 1 },
- "wp:main":
- { "total": 1,
- "valid": 1 } },
- "lemma_sizeof_uint32_t_ok": { "qed": { "total": 1,
- "valid": 1 },
- "wp:main":
- { "total": 1,
- "valid": 1 } },
- "lemma_ax6_ok": { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 1 } },
- "lemma_ax5_ok": { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 1 },
+ "valid": 1 } },
+ "lemma_ax4_ok": { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 1 } },
- "wp:section": { "alt-ergo": { "total": 2,
- "valid": 2,
- "rank": 1 },
- "qed": { "total": 2,
- "valid": 2 },
- "wp:main": { "total": 4,
- "valid": 4,
- "rank": 1 } } } },
+ "valid": 1 } },
+ "wp:section": { "why3:alt-ergo": { "total": 2,
+ "valid": 2 },
+ "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 3,
+ "valid": 3 } } } },
"wp:functions": { "BinaryMultiplication": { "BinaryMultiplication_assert_a3_ok":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 14 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 14 } },
+ "valid": 1 } },
"BinaryMultiplication_assert_a2_ok":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 12 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 12 } },
+ "valid": 1 } },
+ "BinaryMultiplication_loop_invariant_inv2_ok_deductible":
+ { "why3:alt-ergo": { "total": 2,
+ "valid": 2 },
+ "wp:main": { "total": 2,
+ "valid": 2 } },
+ "BinaryMultiplication_loop_invariant_inv1_ok":
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
+ "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main": { "total": 2,
+ "valid": 2 } },
"BinaryMultiplication_assert_a1_ok_deductible":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 3 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 3 } },
+ "valid": 1 } },
"BinaryMultiplication_loop_variant":
- { "alt-ergo": { "total": 2,
- "valid": 2,
- "rank": 19 },
+ { "why3:alt-ergo": { "total": 2,
+ "valid": 2 },
"wp:main": { "total": 2,
- "valid": 2,
- "rank": 19 } },
+ "valid": 2 } },
"BinaryMultiplication_loop_assigns":
{ "qed": { "total": 1,
"valid": 1 },
"wp:main": { "total": 1,
"valid": 1 } },
"BinaryMultiplication_ensures_product":
- { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 34 },
+ { "why3:alt-ergo": { "total": 1,
+ "valid": 1 },
"wp:main": { "total": 1,
- "valid": 1,
- "rank": 34 } },
- "wp:section": { "alt-ergo":
- { "total": 6,
- "valid": 6,
- "rank": 34 },
+ "valid": 1 } },
+ "wp:section": { "why3:alt-ergo":
+ { "total": 9,
+ "valid": 9 },
"qed":
- { "total": 1,
- "valid": 1 },
+ { "total": 2,
+ "valid": 2 },
"wp:main":
- { "total": 7,
- "valid": 7,
- "rank": 34 } } } } }
+ { "total": 11,
+ "valid": 11 } } } } }
diff --git a/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication-without-overflow.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication-without-overflow.res.oracle
index 5b136a7658cd0354170f2f4419e8b46fc2ab56bf..1274212b3de4edfa6b92d981a76d07bae8da56e8 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication-without-overflow.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication-without-overflow.res.oracle
@@ -4,13 +4,11 @@
[wp] Loading driver 'share/wp.driver'
[rte] annotating function BinaryMultiplication
[wp] Goal typed_lemma_ax1_lack : not tried
-[wp] Goal typed_lemma_ax2_lack : not tried
-[wp] Goal typed_lemma_sizeof_uint32_t_ok : trivial
-[wp] Goal typed_lemma_sizeof_uint64_t_ok : trivial
+[wp] Goal typed_lemma_sizeof_ok_ok : trivial
[wp] Goal typed_BinaryMultiplication_ensures_product : not tried
[wp] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_lack_preserved : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_lack_established : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : not tried
[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : not tried
[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : not tried
[wp] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow : not tried
diff --git a/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication.res.oracle
index d37e8c31f601efd5331dd29b2cd443a53cf41528..6473cd6ed5f76aec602b64c92c388b3f294a6c93 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle/binary-multiplication.res.oracle
@@ -6,17 +6,15 @@
[wp] Goal typed_lemma_ax1_lack : not tried
[wp] Goal typed_lemma_ax2_lack : not tried
[wp] Goal typed_lemma_ax3_lack : not tried
-[wp] Goal typed_lemma_ax4_lack : not tried
+[wp] Goal typed_lemma_ax4_ok : not tried
[wp] Goal typed_lemma_ax5_ok : not tried
-[wp] Goal typed_lemma_ax6_ok : not tried
-[wp] Goal typed_lemma_sizeof_uint32_t_ok : trivial
-[wp] Goal typed_lemma_sizeof_uint64_t_ok : trivial
+[wp] Goal typed_lemma_sizeof_ok_ok : trivial
[wp] Goal typed_BinaryMultiplication_ensures_product : not tried
[wp] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_lack_preserved : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_lack_established : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_lack_preserved : not tried
-[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_lack_established : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : not tried
+[wp] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : not tried
[wp] Goal typed_BinaryMultiplication_assert_a2_ok : not tried
[wp] Goal typed_BinaryMultiplication_assert_a3_ok : not tried
[wp] Goal typed_BinaryMultiplication_loop_assigns : trivial
diff --git a/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication-without-overflow.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication-without-overflow.res.oracle
index 9ff5c4e14638d08ecbd7961498b5e8d1016a00c4..54c0e393099c80318ef0b908639542e56799eef3 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication-without-overflow.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication-without-overflow.res.oracle
@@ -3,51 +3,53 @@
[wp] Running WP plugin...
[wp] Loading driver 'share/wp.driver'
[wp] Warning: Missing RTE guards
-[wp] 9 goals scheduled
-[wp] [Qed] Goal typed_lemma_sizeof_uint32_t_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint64_t_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
+[wp] 10 goals scheduled
+[wp] [Qed] Goal typed_lemma_sizeof_ok_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : Valid
+[wp] [Qed] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
[wp] [Qed] Goal typed_BinaryMultiplication_loop_assigns : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
-[wp] Proved goals: 9 / 9
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
+[wp] Proved goals: 10 / 10
Qed: 3
- Alt-Ergo: 6
+ alt-ergo: 7
[wp] Report 'tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json'
-------------------------------------------------------------
Axiomatics WP Alt-Ergo Total Success
-Axiomatic mult 2 - 2 100%
+Axiomatic mult 1 - 1 100%
-------------------------------------------------------------
Functions WP Alt-Ergo Total Success
-BinaryMultiplication 1 6 (64..88) 7 100%
+BinaryMultiplication 2 - 9 100%
-------------------------------------------------------------
[wp] Running WP plugin...
[rte] annotating function BinaryMultiplication
-[wp] 13 goals scheduled
-[wp] [Qed] Goal typed_lemma_sizeof_uint32_t_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint64_t_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_2 : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_3 : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_4 : Valid
+[wp] 14 goals scheduled
+[wp] [Qed] Goal typed_lemma_sizeof_ok_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : Valid
+[wp] [Qed] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_2 : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_3 : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_rte_unsigned_overflow_4 : Valid
[wp] [Qed] Goal typed_BinaryMultiplication_loop_assigns : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
-[wp] Proved goals: 10 / 13
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
+[wp] Proved goals: 11 / 14
Qed: 0
- Alt-Ergo: 10
+ alt-ergo: 11
[wp] Report 'tests/wp_gallery/binary-multiplication-without-overflow.c.0.report.json'
-------------------------------------------------------------
Axiomatics WP Alt-Ergo Total Success
-Axiomatic mult 2 - 2 100%
+Axiomatic mult 1 - 1 100%
-------------------------------------------------------------
Functions WP Alt-Ergo Total Success
-BinaryMultiplication 1 10 (64..88) 11 100%
+BinaryMultiplication 2 - 13 100%
-------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication.res.oracle b/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication.res.oracle
index 4ed3a30466c56941d1f80920b99c2a74bf8b43bd..dd5a5577e64cd94e04a81eac8f0df4277d82c64b 100644
--- a/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication.res.oracle
+++ b/src/plugins/wp/tests/wp_gallery/oracle_qualif/binary-multiplication.res.oracle
@@ -3,51 +3,57 @@
[wp] Running WP plugin...
[wp] Loading driver 'share/wp.driver'
[wp] Warning: Missing RTE guards
-[wp] 11 goals scheduled
-[wp] [Alt-Ergo] Goal typed_lemma_ax5_ok : Valid
-[wp] [Alt-Ergo] Goal typed_lemma_ax6_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint32_t_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint64_t_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a2_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a3_ok : Valid
+[wp] 14 goals scheduled
+[wp] [alt-ergo] Goal typed_lemma_ax4_ok : Valid
+[wp] [alt-ergo] Goal typed_lemma_ax5_ok : Valid
+[wp] [Qed] Goal typed_lemma_sizeof_ok_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : Valid
+[wp] [Qed] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a2_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a3_ok : Valid
[wp] [Qed] Goal typed_BinaryMultiplication_loop_assigns : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
-[wp] Proved goals: 11 / 11
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
+[wp] Proved goals: 14 / 14
Qed: 3
- Alt-Ergo: 8
+ alt-ergo: 11
[wp] Report 'tests/wp_gallery/binary-multiplication.c.0.report.json'
-------------------------------------------------------------
Axiomatics WP Alt-Ergo Total Success
-Axiomatic mult 2 2 (1..12) 4 100%
+Axiomatic mult 1 - 3 100%
-------------------------------------------------------------
Functions WP Alt-Ergo Total Success
-BinaryMultiplication 1 6 (208..256) 7 100%
+BinaryMultiplication 2 - 11 100%
-------------------------------------------------------------
[wp] Running WP plugin...
[rte] annotating function BinaryMultiplication
-[wp] 11 goals scheduled
-[wp] [Alt-Ergo] Goal typed_lemma_ax5_ok : Valid
-[wp] [Alt-Ergo] Goal typed_lemma_ax6_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint32_t_ok : Valid
-[wp] [Qed] Goal typed_lemma_sizeof_uint64_t_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a2_ok : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_assert_a3_ok : Valid
+[wp] 14 goals scheduled
+[wp] [alt-ergo] Goal typed_lemma_ax4_ok : Valid
+[wp] [alt-ergo] Goal typed_lemma_ax5_ok : Valid
+[wp] [Qed] Goal typed_lemma_sizeof_ok_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_ensures_product : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a1_ok_deductible : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_preserved : Valid
+[wp] [Qed] Goal typed_BinaryMultiplication_loop_invariant_inv1_ok_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_preserved : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_invariant_inv2_ok_deductible_established : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a2_ok : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_assert_a3_ok : Valid
[wp] [Qed] Goal typed_BinaryMultiplication_loop_assigns : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
-[wp] [Alt-Ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
-[wp] Proved goals: 8 / 11
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_decrease : Valid
+[wp] [alt-ergo] Goal typed_BinaryMultiplication_loop_variant_positive : Valid
+[wp] Proved goals: 11 / 14
Qed: 0
- Alt-Ergo: 8
+ alt-ergo: 11
[wp] Report 'tests/wp_gallery/binary-multiplication.c.0.report.json'
-------------------------------------------------------------
Axiomatics WP Alt-Ergo Total Success
-Axiomatic mult 2 2 (1..12) 4 100%
+Axiomatic mult 1 - 3 100%
-------------------------------------------------------------
Functions WP Alt-Ergo Total Success
-BinaryMultiplication 1 6 (208..256) 7 100%
+BinaryMultiplication 2 - 11 100%
-------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_plugin/dynamic.i b/src/plugins/wp/tests/wp_plugin/dynamic.i
index f76b892b4b05a3b398b3d46a0cac5a33e7be1e37..ccde8d32cf69e67cc1595503336e8a461d1b98aa 100644
--- a/src/plugins/wp/tests/wp_plugin/dynamic.i
+++ b/src/plugins/wp/tests/wp_plugin/dynamic.i
@@ -1,15 +1,15 @@
/* run.config
- OPT: -wp-dynamic
+ OPT: -wp-dynamic -wp-msg-key "calls"
*/
/* run.config_qualif
OPT: -wp-dynamic -wp
*/
//-----------------------------------------------------------------------------
-/*@
+/*@
requires -10<=x<=10;
- ensures \result == x+1;
- assigns \nothing;
+ ensures \result == x+1;
+ assigns \nothing;
*/
int f1(int x);
@@ -22,7 +22,7 @@ typedef struct S {
} ;
/*@
- requires (closure->f == &f1 && \abs(closure->param)<=5) || closure->f == &f2 ;
+ requires (closure->f == &f1 && \abs(closure->param)<=5) || closure->f == &f2 ;
ensures \abs(\result - closure->param) <= 1 ;
*/
int call(struct S * closure) {
@@ -44,6 +44,49 @@ void guarded_call (struct S * p) {
(* (p->f))(1);
}
+//-----------------------------------------------------------------------------
+int X1;
+//@ assigns X1; ensures X1==1;
+int h1(void);
+
+int X2;
+//@ assigns X2; ensures X2==2;
+int h2(void);
+
+//@ assigns \nothing;
+int h0(void);
+
+/*@ behavior bhv1:
+ @ assumes p == &h1;
+ @ assigns X1;
+ @ ensures X1==1; */
+int behavior (int (*p)(void)) {
+ //@ calls h1, h2; // Shall not be proved in default behavior (known bug)
+ return (*p)();
+}
+
+/*@ behavior bhv1:
+ @ assumes p == &h1;
+ @ assigns X1;
+ @ ensures X1==1;
+ @ behavior bhv0:
+ @ assumes p == &h0;
+ @ assigns \nothing;
+ @ ensures X1==\old(X1); */
+int some_behaviors (int (*p)(void)) {
+ //@ for bhv1,bhv0: calls h1, h2, h0;
+ return (*p)();
+}
+
+/*@
+ ensures X1==1;
+ assigns X1 ;
+*/
+int missing_context (int (*p)(void)) {
+ //@ calls h1 ;
+ return (*p)();
+}
+
//-----------------------------------------------------------------------------
//@ requires \false; ensures \false; exits \false; assigns \nothing;
int unreachable_g(int x);
diff --git a/src/plugins/wp/tests/wp_plugin/dynamic.i.0.report.json b/src/plugins/wp/tests/wp_plugin/dynamic.i.0.report.json
index 4fe7283df198bbb5837161eee37f648eecdb48e6..66c6ff9d15643167fd7f4e0df4ece322f7c3ac52 100644
--- a/src/plugins/wp/tests/wp_plugin/dynamic.i.0.report.json
+++ b/src/plugins/wp/tests/wp_plugin/dynamic.i.0.report.json
@@ -1,36 +1,38 @@
-{ "wp:global": { "alt-ergo": { "total": 3, "valid": 3, "rank": 14 },
- "qed": { "total": 10, "valid": 10 },
- "wp:main": { "total": 13, "valid": 13, "rank": 14 } },
+{ "wp:global": { "alt-ergo": { "total": 4, "valid": 3, "unknown": 1,
+ "rank": 16 },
+ "qed": { "total": 47, "valid": 47 },
+ "wp:main": { "total": 51, "valid": 50, "unknown": 1,
+ "rank": 16 } },
"wp:functions": { "call": { "f1_requires": { "alt-ergo": { "total": 1,
"valid": 1,
- "rank": 14 },
+ "rank": 16 },
"wp:main": { "total": 1,
"valid": 1,
- "rank": 14 } },
- "call_calls_f1_f2_s3": { "alt-ergo": { "total": 1,
- "valid": 1,
- "rank": 6 },
- "wp:main": { "total": 1,
- "valid": 1,
- "rank": 6 } },
+ "rank": 16 } },
+ "call_call_point_f1_f2_s3": { "alt-ergo":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1,
+ "rank": 8 } },
"call_ensures": { "qed": { "total": 2,
"valid": 2 },
"wp:main": { "total": 2,
"valid": 2 } },
"wp:section": { "alt-ergo": { "total": 2,
"valid": 2,
- "rank": 14 },
+ "rank": 16 },
"qed": { "total": 2,
"valid": 2 },
"wp:main": { "total": 4,
"valid": 4,
- "rank": 14 } } },
- "guarded_call": { "guarded_call_calls_g_s9": { "qed":
- { "total": 1,
- "valid": 1 },
- "wp:main":
- { "total": 1,
- "valid": 1 } },
+ "rank": 16 } } },
+ "guarded_call": { "guarded_call_call_point_g_s9":
+ { "qed": { "total": 1, "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } },
"guarded_call_ensures_2": { "qed":
{ "total": 2,
"valid": 2 },
@@ -40,33 +42,103 @@
"guarded_call_ensures": { "alt-ergo":
{ "total": 1,
"valid": 1,
- "rank": 4 },
+ "rank": 5 },
"qed":
{ "total": 1,
"valid": 1 },
"wp:main":
{ "total": 2,
"valid": 2,
- "rank": 4 } },
+ "rank": 5 } },
"wp:section": { "alt-ergo": { "total": 1,
"valid": 1,
- "rank": 4 },
+ "rank": 5 },
"qed": { "total": 4,
"valid": 4 },
"wp:main": { "total": 5,
"valid": 5,
- "rank": 4 } } },
- "no_call": { "unreachable_g_requires": { "qed": { "total": 1,
+ "rank": 5 } } },
+ "behavior": { "behavior_call_point_h1_h2_s15": { "qed":
+ { "total": 1,
"valid": 1 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1 } },
+ "behavior_bhv1_assigns": { "qed": { "total": 6,
+ "valid": 6 },
"wp:main":
- { "total": 1,
- "valid": 1 } },
- "no_call_calls_unreachable_g_s17": { "qed":
+ { "total": 6,
+ "valid": 6 } },
+ "behavior_bhv1_ensures": { "qed": { "total": 2,
+ "valid": 2 },
+ "wp:main":
+ { "total": 2,
+ "valid": 2 } },
+ "wp:section": { "qed": { "total": 9,
+ "valid": 9 },
+ "wp:main": { "total": 9,
+ "valid": 9 } } },
+ "some_behaviors": { "some_behaviors_call_point_h1_h2_h0_for_bhv1_s20":
+ { "qed": { "total": 1, "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } },
+ "some_behaviors_call_point_h1_h2_h0_for_bhv0_s20":
+ { "qed": { "total": 1, "valid": 1 },
+ "wp:main": { "total": 1,
+ "valid": 1 } },
+ "some_behaviors_bhv1_assigns":
+ { "qed": { "total": 7, "valid": 7 },
+ "wp:main": { "total": 7,
+ "valid": 7 } },
+ "some_behaviors_bhv0_assigns":
+ { "qed": { "total": 9, "valid": 9 },
+ "wp:main": { "total": 9,
+ "valid": 9 } },
+ "some_behaviors_bhv0_ensures":
+ { "qed": { "total": 3, "valid": 3 },
+ "wp:main": { "total": 3,
+ "valid": 3 } },
+ "some_behaviors_bhv1_ensures":
+ { "qed": { "total": 3, "valid": 3 },
+ "wp:main": { "total": 3,
+ "valid": 3 } },
+ "wp:section": { "qed": { "total": 24,
+ "valid": 24 },
+ "wp:main": { "total": 24,
+ "valid": 24 } } },
+ "missing_context": { "missing_context_call_point_h1_s25":
+ { "alt-ergo": { "total": 1,
+ "unknown": 1 },
+ "wp:main": { "total": 1,
+ "unknown": 1 } },
+ "missing_context_assigns": { "qed":
+ { "total": 3,
+ "valid": 3 },
+ "wp:main":
+ { "total": 3,
+ "valid": 3 } },
+ "missing_context_ensures": { "qed":
{ "total": 1,
"valid": 1 },
"wp:main":
{ "total": 1,
"valid": 1 } },
+ "wp:section": { "alt-ergo":
+ { "total": 1,
+ "unknown": 1 },
+ "qed": { "total": 4,
+ "valid": 4 },
+ "wp:main": { "total": 5,
+ "valid": 4,
+ "unknown": 1 } } },
+ "no_call": { "unreachable_g_requires": { "qed": { "total": 1,
+ "valid": 1 },
+ "wp:main":
+ { "total": 1,
+ "valid": 1 } },
+ "no_call_call_point_unreachable_g_s32":
+ { "qed": { "total": 1, "valid": 1 },
+ "wp:main": { "total": 1, "valid": 1 } },
"no_call_ensures": { "qed": { "total": 2,
"valid": 2 },
"wp:main": { "total": 2,
diff --git a/src/plugins/wp/tests/wp_plugin/oracle/dynamic.res.oracle b/src/plugins/wp/tests/wp_plugin/oracle/dynamic.res.oracle
index 6aac439104f2110cfb2cfc488641ebb43666c2dc..7c09c9927c004037dde903f98a89aafaa9348cef 100644
--- a/src/plugins/wp/tests/wp_plugin/oracle/dynamic.res.oracle
+++ b/src/plugins/wp/tests/wp_plugin/oracle/dynamic.res.oracle
@@ -1,15 +1,81 @@
# frama-c -wp [...]
[kernel] Parsing tests/wp_plugin/dynamic.i (no preprocessing)
[wp] Running WP plugin...
-[wp] Computing dynamic calls.
-[wp] Dynamic call(s): 3.
+[wp:calls] Computing dynamic calls.
+[wp] tests/wp_plugin/dynamic.i:30: Calls f1 f2
+[wp] tests/wp_plugin/dynamic.i:44: Calls g
+[wp] tests/wp_plugin/dynamic.i:65: Calls h1 h2
+[wp] tests/wp_plugin/dynamic.i:78: Calls (for bhv1) h1 h2 h0
+[wp] tests/wp_plugin/dynamic.i:78: Calls (for bhv0) h1 h2 h0
+[wp] tests/wp_plugin/dynamic.i:87: Calls h1
+[wp] tests/wp_plugin/dynamic.i:100: Calls unreachable_g
+[wp:calls] Dynamic call(s): 6.
[wp] Loading driver 'share/wp.driver'
+[wp] tests/wp_plugin/dynamic.i:78: Warning: Missing 'calls' for default behavior
[wp] Warning: Missing RTE guards
+------------------------------------------------------------
+ Function behavior with behavior bhv1
+------------------------------------------------------------
+
+Goal Call point h1 h2 in 'behavior' at instruction (file tests/wp_plugin/dynamic.i, line 65):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv1' (file tests/wp_plugin/dynamic.i, line 62) in 'behavior' (1/2):
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv1' (file tests/wp_plugin/dynamic.i, line 62) in 'behavior' (2/2):
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (1/2):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (2/2):
+Call Effect at line 65
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (1/4):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (2/4):
+Call Effect at line 65
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (3/4):
+Call Result at line 65
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 61) in 'behavior' (4/4):
+Call Result at line 65
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
------------------------------------------------------------
Function call
------------------------------------------------------------
-Goal calls f1 f2 in 'call' at instruction (file tests/wp_plugin/dynamic.i, line 30):
+Goal Call point f1 f2 in 'call' at instruction (file tests/wp_plugin/dynamic.i, line 30):
Let a = Mptr_0[shiftfield_F1_S_f(closure_0)].
Let a_1 = global(G_f2_26).
Let a_2 = global(G_f1_20).
@@ -48,6 +114,7 @@ Assume {
(* Pre-condition *)
Have: abs_int(x) <= 5.
(* Instance of 'f1' *)
+ (* Call point f1 f2 *)
Have: Mptr_0[shiftfield_F1_S_f(closure_0)] = global(G_f1_20).
}
Prove: ((-10) <= x) /\ (x <= 10).
@@ -57,7 +124,7 @@ Prove: ((-10) <= x) /\ (x <= 10).
Function guarded_call
------------------------------------------------------------
-Goal calls g in 'guarded_call' at instruction (file tests/wp_plugin/dynamic.i, line 44):
+Goal Call point g in 'guarded_call' at instruction (file tests/wp_plugin/dynamic.i, line 44):
Prove: true.
------------------------------------------------------------
@@ -91,33 +158,230 @@ Goal Post-condition (file tests/wp_plugin/dynamic.i, line 39) in 'guarded_call'
Tags: Call g.
Prove: true.
+------------------------------------------------------------
+------------------------------------------------------------
+ Function missing_context
+------------------------------------------------------------
+
+Goal Call point h1 in 'missing_context' at instruction (file tests/wp_plugin/dynamic.i, line 87):
+Assume { (* Heap *) Have: region(p.base) <= 0. }
+Prove: global(G_h1_57) = p.
+
+------------------------------------------------------------
+
+Goal Post-condition (file tests/wp_plugin/dynamic.i, line 82) in 'missing_context':
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns (file tests/wp_plugin/dynamic.i, line 83) in 'missing_context':
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns (file tests/wp_plugin/dynamic.i, line 83) in 'missing_context' (1/2):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns (file tests/wp_plugin/dynamic.i, line 83) in 'missing_context' (2/2):
+Call Result at line 87
+Tags: Call h1.
+Prove: true.
+
------------------------------------------------------------
------------------------------------------------------------
Function no_call
------------------------------------------------------------
-Goal calls unreachable_g in 'no_call' at instruction (file tests/wp_plugin/dynamic.i, line 57):
+Goal Call point unreachable_g in 'no_call' at instruction (file tests/wp_plugin/dynamic.i, line 100):
Prove: true.
------------------------------------------------------------
-Goal Post-condition (file tests/wp_plugin/dynamic.i, line 51) in 'no_call' (1/2):
+Goal Post-condition (file tests/wp_plugin/dynamic.i, line 94) in 'no_call' (1/2):
Prove: true.
------------------------------------------------------------
-Goal Post-condition (file tests/wp_plugin/dynamic.i, line 51) in 'no_call' (2/2):
+Goal Post-condition (file tests/wp_plugin/dynamic.i, line 94) in 'no_call' (2/2):
Tags: Call unreachable_g.
Prove: true.
------------------------------------------------------------
-Goal Instance of 'Pre-condition (file tests/wp_plugin/dynamic.i, line 48) in 'unreachable_g'' in 'no_call' at instruction (file tests/wp_plugin/dynamic.i, line 57)
+Goal Instance of 'Pre-condition (file tests/wp_plugin/dynamic.i, line 91) in 'unreachable_g'' in 'no_call' at instruction (file tests/wp_plugin/dynamic.i, line 100)
:
Tags: Call unreachable_g.
Prove: true.
+------------------------------------------------------------
+------------------------------------------------------------
+ Function some_behaviors with behavior bhv0
+------------------------------------------------------------
+
+Goal Call point h1 h2 h0 for bhv0 in 'some_behaviors' at instruction (file tests/wp_plugin/dynamic.i, line 78):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv0' (file tests/wp_plugin/dynamic.i, line 75) in 'some_behaviors' (1/3):
+Tags: Call h0.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv0' (file tests/wp_plugin/dynamic.i, line 75) in 'some_behaviors' (2/3):
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv0' (file tests/wp_plugin/dynamic.i, line 75) in 'some_behaviors' (3/3):
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (1/3):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (2/3):
+Call Effect at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (3/3):
+Call Effect at line 78
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (1/6):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (2/6):
+Call Effect at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (3/6):
+Call Effect at line 78
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (4/6):
+Call Result at line 78
+Tags: Call h0.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (5/6):
+Call Result at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv0' nothing in 'some_behaviors' (6/6):
+Call Result at line 78
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+------------------------------------------------------------
+ Function some_behaviors with behavior bhv1
+------------------------------------------------------------
+
+Goal Call point h1 h2 h0 for bhv1 in 'some_behaviors' at instruction (file tests/wp_plugin/dynamic.i, line 78):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv1' (file tests/wp_plugin/dynamic.i, line 71) in 'some_behaviors' (1/3):
+Tags: Call h0.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv1' (file tests/wp_plugin/dynamic.i, line 71) in 'some_behaviors' (2/3):
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Post-condition for 'bhv1' (file tests/wp_plugin/dynamic.i, line 71) in 'some_behaviors' (3/3):
+Tags: Call h1.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (1/2):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (2/2):
+Call Effect at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (1/5):
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (2/5):
+Call Effect at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (3/5):
+Call Result at line 78
+Tags: Call h0.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (4/5):
+Call Result at line 78
+Tags: Call h2.
+Prove: true.
+
+------------------------------------------------------------
+
+Goal Assigns for 'bhv1' (file tests/wp_plugin/dynamic.i, line 70) in 'some_behaviors' (5/5):
+Call Result at line 78
+Tags: Call h1.
+Prove: true.
+
------------------------------------------------------------
[wp] Warning: Memory model hypotheses for function 'guarded_call':
/*@ behavior typed: requires \separated(&X,p); */
void guarded_call(struct S *p);
+[wp] Warning: Memory model hypotheses for function 'behavior':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int behavior(int (*p)(void));
+[wp] Warning: Memory model hypotheses for function 'some_behaviors':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int some_behaviors(int (*p)(void));
+[wp] Warning: Memory model hypotheses for function 'missing_context':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int missing_context(int (*p)(void));
diff --git a/src/plugins/wp/tests/wp_plugin/oracle_qualif/dynamic.res.oracle b/src/plugins/wp/tests/wp_plugin/oracle_qualif/dynamic.res.oracle
index 15f401314ed824e3543507ac6c947915f700648a..d6cbf500964e4ff7407ae0ee9c73160dbb6ee164 100644
--- a/src/plugins/wp/tests/wp_plugin/oracle_qualif/dynamic.res.oracle
+++ b/src/plugins/wp/tests/wp_plugin/oracle_qualif/dynamic.res.oracle
@@ -1,34 +1,83 @@
# frama-c -wp -wp-timeout 90 -wp-steps 1500 [...]
[kernel] Parsing tests/wp_plugin/dynamic.i (no preprocessing)
[wp] Running WP plugin...
-[wp] Computing dynamic calls.
-[wp] Dynamic call(s): 3.
[wp] Loading driver 'share/wp.driver'
+[wp] tests/wp_plugin/dynamic.i:78: Warning: Missing 'calls' for default behavior
[wp] Warning: Missing RTE guards
-[wp] 13 goals scheduled
-[wp] [Alt-Ergo] Goal typed_call_calls_f1_f2_s3 : Valid
+[wp] 51 goals scheduled
+[wp] [Qed] Goal typed_behavior_call_point_h1_h2_s15 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_ensures_part1 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_ensures_part2 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_exit_part1 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_exit_part2 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_normal_part1 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_normal_part2 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_normal_part3 : Valid
+[wp] [Qed] Goal typed_behavior_bhv1_assigns_normal_part4 : Valid
+[wp] [Alt-Ergo] Goal typed_call_call_point_f1_f2_s3 : Valid
[wp] [Qed] Goal typed_call_ensures_part1 : Valid
[wp] [Qed] Goal typed_call_ensures_part2 : Valid
[wp] [Alt-Ergo] Goal typed_call_call_f1_requires : Valid
-[wp] [Qed] Goal typed_guarded_call_calls_g_s9 : Valid
+[wp] [Qed] Goal typed_guarded_call_call_point_g_s9 : Valid
[wp] [Alt-Ergo] Goal typed_guarded_call_ensures_part1 : Valid
[wp] [Qed] Goal typed_guarded_call_ensures_part2 : Valid
[wp] [Qed] Goal typed_guarded_call_ensures_2_part1 : Valid
[wp] [Qed] Goal typed_guarded_call_ensures_2_part2 : Valid
-[wp] [Qed] Goal typed_no_call_calls_unreachable_g_s17 : Valid
+[wp] [Alt-Ergo] Goal typed_missing_context_call_point_h1_s25 : Unknown
+[wp] [Qed] Goal typed_missing_context_ensures : Valid
+[wp] [Qed] Goal typed_missing_context_assigns_exit : Valid
+[wp] [Qed] Goal typed_missing_context_assigns_normal_part1 : Valid
+[wp] [Qed] Goal typed_missing_context_assigns_normal_part2 : Valid
+[wp] [Qed] Goal typed_no_call_call_point_unreachable_g_s32 : Valid
[wp] [Qed] Goal typed_no_call_ensures_part1 : Valid
[wp] [Qed] Goal typed_no_call_ensures_part2 : Valid
[wp] [Qed] Goal typed_no_call_call_unreachable_g_requires : Valid
-[wp] Proved goals: 13 / 13
- Qed: 10
- Alt-Ergo: 3
+[wp] [Qed] Goal typed_some_behaviors_call_point_h1_h2_h0_for_bhv0_s20 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_ensures_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_ensures_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_ensures_part3 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_exit_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_exit_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_exit_part3 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part3 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part4 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part5 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv0_assigns_normal_part6 : Valid
+[wp] [Qed] Goal typed_some_behaviors_call_point_h1_h2_h0_for_bhv1_s20 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_ensures_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_ensures_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_ensures_part3 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_exit_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_exit_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_normal_part1 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_normal_part2 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_normal_part3 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_normal_part4 : Valid
+[wp] [Qed] Goal typed_some_behaviors_bhv1_assigns_normal_part5 : Valid
+[wp] Proved goals: 50 / 51
+ Qed: 47
+ Alt-Ergo: 3 (unknown: 1)
[wp] Report 'tests/wp_plugin/dynamic.i.0.report.json'
-------------------------------------------------------------
Functions WP Alt-Ergo Total Success
-call 2 2 (52..64) 4 100%
-guarded_call 4 1 (12..24) 5 100%
+call 2 2 (56..80) 4 100%
+guarded_call 4 1 (16..28) 5 100%
+behavior 9 - 9 100%
+some_behaviors 24 - 24 100%
+missing_context 4 - 5 80.0%
no_call 4 - 4 100%
-------------------------------------------------------------
[wp] Warning: Memory model hypotheses for function 'guarded_call':
/*@ behavior typed: requires \separated(&X,p); */
void guarded_call(struct S *p);
+[wp] Warning: Memory model hypotheses for function 'behavior':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int behavior(int (*p)(void));
+[wp] Warning: Memory model hypotheses for function 'some_behaviors':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int some_behaviors(int (*p)(void));
+[wp] Warning: Memory model hypotheses for function 'missing_context':
+ /*@ behavior typed: requires \separated(&X1,p); */
+ int missing_context(int (*p)(void));
diff --git a/src/plugins/wp/tests/wp_plugin/oracle_qualif/unsigned.res.oracle b/src/plugins/wp/tests/wp_plugin/oracle_qualif/unsigned.res.oracle
index 4f621599bac38e47ca39ce0880501e65167c7dd6..8a4e9399f451a852b7e1338479604b6bf9f45d7a 100644
--- a/src/plugins/wp/tests/wp_plugin/oracle_qualif/unsigned.res.oracle
+++ b/src/plugins/wp/tests/wp_plugin/oracle_qualif/unsigned.res.oracle
@@ -10,5 +10,5 @@
[wp] Report 'tests/wp_plugin/unsigned.i.0.report.json'
-------------------------------------------------------------
Axiomatics WP Alt-Ergo Total Success
-Lemma - - 1 100%
+Lemma - - (4..16) 1 100%
-------------------------------------------------------------
diff --git a/src/plugins/wp/tests/wp_plugin/string_c.c.0.report.json b/src/plugins/wp/tests/wp_plugin/string_c.c.0.report.json
index c36b874055fa6135a97ad7aadb2b4b37f77cca50..910cff1aa784f7f216414880ab65cc8d0e445a24 100644
--- a/src/plugins/wp/tests/wp_plugin/string_c.c.0.report.json
+++ b/src/plugins/wp/tests/wp_plugin/string_c.c.0.report.json
@@ -15,20 +15,20 @@
"memcpy_loop_invariant_no_eva": { "alt-ergo":
{ "total": 2,
"valid": 2,
- "rank": 17 },
+ "rank": 16 },
"wp:main":
{ "total": 2,
"valid": 2,
- "rank": 17 } },
+ "rank": 16 } },
"memcpy_loop_variant": { "alt-ergo":
{ "total": 1,
"valid": 1,
- "rank": 17 },
+ "rank": 16 },
"qed": { "total": 1,
"valid": 1 },
"wp:main": { "total": 2,
"valid": 2,
- "rank": 17 } },
+ "rank": 16 } },
"memcpy_assigns": { "qed": { "total": 1,
"valid": 1 },
"wp:main": { "total": 1,
@@ -94,14 +94,14 @@
"memmove_loop_invariant_no_eva_3": { "alt-ergo":
{ "total": 1,
"valid": 1,
- "rank": 82 },
+ "rank": 81 },
"qed":
{ "total": 1,
"valid": 1 },
"wp:main":
{ "total": 2,
"valid": 2,
- "rank": 82 } },
+ "rank": 81 } },
"memmove_loop_invariant_no_eva_2": { "alt-ergo":
{ "total": 1,
"valid": 1,
diff --git a/src/plugins/wp/tests/wp_plugin/unroll.i b/src/plugins/wp/tests/wp_plugin/unroll.i
index dd79473b668aa1805dba478d721bcfe5552c158e..5ac917b0ddb23b34e0df8188e75e75a800e4a895 100644
--- a/src/plugins/wp/tests/wp_plugin/unroll.i
+++ b/src/plugins/wp/tests/wp_plugin/unroll.i
@@ -1,5 +1,5 @@
/* run.config
- OPT: -ulevel=1 -wp -wp-prop=@ensures -wp-prover script -session tests/wp_plugin/unroll
+ OPT: -ulevel=1 -wp -wp-prop=@ensures -wp-prover script -session tests/wp_plugin/unroll -wp-msg-key no-time-info,no-step-info
*/
/* run.config_qualif
diff --git a/src/plugins/wp/tests/wp_plugin/unsigned.i.0.report.json b/src/plugins/wp/tests/wp_plugin/unsigned.i.0.report.json
index bcf9b8a1f6f09696d76168b9fc53d18ad5bc52e1..e786ec578aca591188dffba000253a94180ce50d 100644
--- a/src/plugins/wp/tests/wp_plugin/unsigned.i.0.report.json
+++ b/src/plugins/wp/tests/wp_plugin/unsigned.i.0.report.json
@@ -1,10 +1,13 @@
-{ "wp:global": { "script": { "total": 1, "valid": 1 },
- "wp:main": { "total": 1, "valid": 1 } },
- "wp:axiomatics": { "": { "lemma_U32": { "script": { "total": 1,
- "valid": 1 },
+{ "wp:global": { "script": { "total": 1, "valid": 1, "rank": 2 },
+ "wp:main": { "total": 1, "valid": 1, "rank": 2 } },
+ "wp:axiomatics": { "": { "lemma_U32": { "script": { "total": 1, "valid": 1,
+ "rank": 2 },
"wp:main": { "total": 1,
- "valid": 1 } },
+ "valid": 1,
+ "rank": 2 } },
"wp:section": { "script": { "total": 1,
- "valid": 1 },
+ "valid": 1,
+ "rank": 2 },
"wp:main": { "total": 1,
- "valid": 1 } } } } }
+ "valid": 1,
+ "rank": 2 } } } } }
diff --git a/src/plugins/wp/wpAnnot.ml b/src/plugins/wp/wpAnnot.ml
index cffa1268c684c66beb4e9161aeb2a7aa346c7982..81744b579a92317b77a4d957d7116ff5a5213165 100644
--- a/src/plugins/wp/wpAnnot.ml
+++ b/src/plugins/wp/wpAnnot.ml
@@ -219,6 +219,10 @@ let name_of_asked_bhv = function
| FunBhv None -> Cil.default_behavior_name
| StmtBhv (_, _, _, bhv) -> bhv.b_name
+let asked_bhv = function
+ | FunBhv None -> None
+ | FunBhv (Some bhv) | StmtBhv (_,_,_,bhv) -> Some bhv.b_name
+
(* This is to code what properties the user asked for in a given behavior. *)
type asked_prop =
| AllProps
@@ -765,20 +769,20 @@ let get_call_annots config v s fct =
| Cil2cfg.Static kf -> add_call_annots config s kf l_post empty
| Cil2cfg.Dynamic _ ->
- let calls = Dyncall.get ~bhv:(name_of_asked_bhv config.cur_bhv) s in
- if calls=[] then
- begin
+ let bhv = asked_bhv config.cur_bhv in
+ match Dyncall.get ?bhv s with
+ | None | Some(_,[]) ->
Wp_parameters.warning ~once:true ~source:(fst (Stmt.loc s))
- "Ignored function pointer (see -wp-dynamic)" ;
+ "Missing 'calls' for %s"
+ (match bhv with
+ | None -> "default behavior"
+ | Some b -> b) ;
let annots = WpStrategy.add_call_assigns_any WpStrategy.empty_acc s in
WpStrategy.empty_acc, (annots , annots)
- end
- else
- begin
+ | Some(_,calls) ->
List.fold_left
(fun acc kf -> add_call_annots config s kf l_post acc)
empty calls
- end
(*----------------------------------------------------------------------------*)
let add_variant_annot config s ca var_exp loop_entry loop_back =
diff --git a/src/plugins/wp/wpPropId.ml b/src/plugins/wp/wpPropId.ml
index 7ee846ce041899d1ccc150f7655f6304006de089..7c2583caaf67aabc0f6133d09e4cb50880a1c166 100644
--- a/src/plugins/wp/wpPropId.ml
+++ b/src/plugins/wp/wpPropId.ml
@@ -423,7 +423,7 @@ let code_annot_names ca = match ca.annot_content with
| AAssert (_, named_pred) -> "@assert"::(ident_names named_pred.pred_name)
| AInvariant (_,_,named_pred) -> "@invariant"::(ident_names named_pred.pred_name)
| AVariant (term, _) -> "@variant"::(ident_names term.term_name)
- | AExtended(_,_,(_,name,_,_)) -> [Printf.sprintf "@%s" name]
+ | AExtended(_,_,(_,name,_,_,_)) -> [Printf.sprintf "@%s" name]
| _ -> [] (* TODO : add some more names ? *)
(** This is used to give the name of the property that the user can give
@@ -432,7 +432,7 @@ let user_prop_names p = match p with
| Property.IPPredicate (kind,_,_,idp) ->
Format.asprintf "@@%a" Property.pretty_predicate_kind kind ::
idp.ip_content.pred_name
- | Property.IPExtended(_,(_,name,_,_)) -> [ Printf.sprintf "@%s" name ]
+ | Property.IPExtended(_,(_,name,_,_,_)) -> [ Printf.sprintf "@%s" name ]
| Property.IPCodeAnnot (_,_, ca) -> code_annot_names ca
| Property.IPComplete (_, _,_,lb) ->
let kind_name = "@complete_behaviors" in
@@ -605,7 +605,7 @@ let property_hints hs = function
List.iter (add_required hs) ps
| Property.IPPredicate(_,_,_,ipred) ->
List.iter (add_hint hs) ipred.ip_content.pred_name
- | Property.IPExtended(_,(_,name,_,_)) -> List.iter (add_hint hs) [name]
+ | Property.IPExtended(_,(_,name,_,_,_)) -> List.iter (add_hint hs) [name]
| Property.IPCodeAnnot(_,_,ca) -> annot_hints hs ca.annot_content
| Property.IPAssigns(_,_,_,froms) -> assigns_hints hs froms
| Property.IPAllocation _ (* TODO *)
diff --git a/src/plugins/wp/wp_parameters.ml b/src/plugins/wp/wp_parameters.ml
index db7b65a2d0d3f2dc532fa69c090a12c3634c0657..9222639296b0f70ef47ae9602868db255f8271bb 100644
--- a/src/plugins/wp/wp_parameters.ml
+++ b/src/plugins/wp/wp_parameters.ml
@@ -313,7 +313,7 @@ module SplitDepth =
let () = Parameter_customize.set_group wp_strategy
module DynCall =
- False(struct
+ True(struct
let option_name = "-wp-dynamic"
let help = "Handle dynamic calls with specific annotations."
end)
diff --git a/src/plugins/wp/wpo.ml b/src/plugins/wp/wpo.ml
index 8a20407e53338db5485ec741ba9092b980ec6bbe..b4ff5124a5c54d708891290a466c0566b4c08f0f 100644
--- a/src/plugins/wp/wpo.ml
+++ b/src/plugins/wp/wpo.ml
@@ -805,11 +805,19 @@ let is_trivial g =
| GoalAnnot vc -> VC_Annot.is_trivial vc
| GoalCheck _ -> false
-let resolve g =
+
+let reduce g =
match g.po_formula with
- | GoalAnnot vc -> Model.with_model g.po_model VC_Annot.resolve vc
- | GoalLemma vc -> Model.with_model g.po_model VC_Lemma.is_trivial vc
| GoalCheck _ -> false
+ | GoalLemma vc -> Model.with_model g.po_model VC_Lemma.is_trivial vc
+ | GoalAnnot vc -> Model.with_model g.po_model VC_Annot.resolve vc
+
+let resolve g =
+ let valid = reduce g in
+ if valid then
+ ( let solver = qed_time g in
+ set_result g VCS.Qed (VCS.result ~solver VCS.Valid) ) ;
+ valid
let compute g =
match g.po_formula with
diff --git a/src/plugins/wp/wpo.mli b/src/plugins/wp/wpo.mli
index 9413c844b02e32eb94e06c950d0af43196378001..ffe0871674f0f168c3d62bae4c5d4a78d1960e0b 100644
--- a/src/plugins/wp/wpo.mli
+++ b/src/plugins/wp/wpo.mli
@@ -157,7 +157,8 @@ val on_remove : (t -> unit) -> unit
val add : t -> unit
val age : t -> int (* generation *)
-val resolve : t -> bool (** tries simplification *)
+val reduce : t -> bool (** tries simplification *)
+val resolve : t -> bool (** tries simplification and set result if valid *)
val set_result : t -> prover -> result -> unit
val clear_results : t -> unit
diff --git a/tests/builtins/oracle/memcpy.res.oracle b/tests/builtins/oracle/memcpy.res.oracle
index 286bbe329a045436cc10b60d93aa8aa30853ca7f..056a7d23f9316f95d9dada935a0a42ab3796252d 100644
--- a/tests/builtins/oracle/memcpy.res.oracle
+++ b/tests/builtins/oracle/memcpy.res.oracle
@@ -1690,6 +1690,8 @@
--- Properties of Function 'bzero'
--------------------------------------------------------------------------------
+[ Extern ] Post-condition 's_initialized,initialization'
+ Unverifiable but considered Valid.
[ Extern ] Post-condition 'zero_initialized'
Unverifiable but considered Valid.
[ Extern ] Assigns (file share/libc/strings.h, line 37)
@@ -1705,7 +1707,7 @@
[ Extern ] Assigns nothing
Unverifiable but considered Valid.
-[ Extern ] Froms (file share/libc/strings.h, line 47)
+[ Extern ] Froms (file share/libc/strings.h, line 48)
Unverifiable but considered Valid.
[ Valid ] Default behavior
by Frama-C kernel.
@@ -1716,7 +1718,7 @@
[ Extern ] Assigns nothing
Unverifiable but considered Valid.
-[ Extern ] Froms (file share/libc/strings.h, line 54)
+[ Extern ] Froms (file share/libc/strings.h, line 55)
Unverifiable but considered Valid.
[ Valid ] Default behavior
by Frama-C kernel.
@@ -2133,8 +2135,8 @@
--- Status Report Summary
--------------------------------------------------------------------------------
156 Completely validated
- 215 Considered valid
+ 216 Considered valid
29 To be validated
4 Alarms emitted
- 404 Total
+ 405 Total
--------------------------------------------------------------------------------
diff --git a/tests/libc/fc_libc.c b/tests/libc/fc_libc.c
index 298bc1b03740873f4764513b51d10747b6869bd3..5688d0e6e4f9e8c9ab57ab0ce3c62c2b9fdbdbd0 100644
--- a/tests/libc/fc_libc.c
+++ b/tests/libc/fc_libc.c
@@ -85,13 +85,7 @@
#include "inttypes.h"
#include "iso646.h"
#include "libgen.h"
-#include "libintl.h"
#include "limits.h"
-#include "linux/fs.h"
-#include "linux/if_addr.h"
-#include "linux/if_netlink.h"
-#include "linux/netlink.h"
-#include "linux/rtnetlink.h"
#include "locale.h"
#include "malloc.h"
#include "math.h"
@@ -99,9 +93,6 @@
#include "netdb.h"
#include "net/if.h"
#include "netinet/in.h"
-#include "netinet/in_systm.h"
-#include "netinet/ip.h"
-#include "netinet/ip_icmp.h"
#include "netinet/tcp.h"
#include "nl_types.h"
#include "poll.h"
@@ -127,7 +118,6 @@
#include "sys/ipc.h"
#include "syslog.h"
#include "sys/mman.h"
-#include "sys/param.h"
#include "sys/random.h"
#include "sys/resource.h"
#include "sys/select.h"
@@ -135,7 +125,6 @@
#include "sys/signal.h"
#include "sys/socket.h"
#include "sys/stat.h"
-#include "sys/sysctl.h"
#include "sys/time.h"
#include "sys/times.h"
#include "sys/timex.h"
@@ -147,7 +136,6 @@
#include "termios.h"
#include "tgmath.h"
#include "time.h"
-#include "uchar.h"
#include "unistd.h"
#include "utime.h"
#include "utmpx.h"
diff --git a/tests/libc/libgen_h.c b/tests/libc/libgen_h.c
new file mode 100644
index 0000000000000000000000000000000000000000..df9e7eaf4c2e3f29d8f6deb6b76e7b5c4fb9fbab
--- /dev/null
+++ b/tests/libc/libgen_h.c
@@ -0,0 +1,20 @@
+/*run.config
+
+*/
+
+#include <libgen.h>
+
+int main() {
+ char path[128] = "/tmp/bla/ble.c";
+ char *base = basename(path);
+ //@ assert valid_string(base);
+ char *base2 = basename(0);
+ //@ assert valid_string(base2);
+
+ char *dir = dirname(path);
+ //@ assert valid_string(dir);
+ char *dir2 = dirname(0);
+ //@ assert valid_string(dir2);
+
+ return 0;
+}
diff --git a/tests/libc/netdb_c.c b/tests/libc/netdb_c.c
index ab3f26fe01cc2064fcbd2de3e9a4dce0f3f1c245..6e8f905b5d80c9afc8f77fadc6e5de394469710c 100644
--- a/tests/libc/netdb_c.c
+++ b/tests/libc/netdb_c.c
@@ -68,5 +68,10 @@ int main() {
freeaddrinfo(result); /* No longer needed */
+ struct hostent *h = gethostbyname("localhost");
+ if (h) {
+ char *addrs = h->h_addr;
+ int l = h->h_length;
+ }
return 0;
}
diff --git a/tests/libc/oracle/coverage.res.oracle b/tests/libc/oracle/coverage.res.oracle
index 022ec6cf4bf93925c11032ef63434f829269cac5..6c5fe3be202d1c7a64d8bd4f0dbc15e336cac7d4 100644
--- a/tests/libc/oracle/coverage.res.oracle
+++ b/tests/libc/oracle/coverage.res.oracle
@@ -28,7 +28,7 @@
main: 4 stmts out of 4 (100.0%)
[metrics] Eva coverage statistics
=======================
- Syntactically reachable functions = 2 (out of 75)
+ Syntactically reachable functions = 2 (out of 76)
Semantically reached functions = 2
Coverage estimation = 100.0%
[metrics] Statements analyzed by Eva
diff --git a/tests/libc/oracle/fc_libc.0.res.oracle b/tests/libc/oracle/fc_libc.0.res.oracle
index c1ea9b1264b8f540555594d7684ce6cc084d13d7..b48eca2cad51fdf2242e6c45aedffac3c1f01bc1 100644
--- a/tests/libc/oracle/fc_libc.0.res.oracle
+++ b/tests/libc/oracle/fc_libc.0.res.oracle
@@ -4,43 +4,44 @@
[eva] Initial state computed
[eva:initial-state] Values of globals at initialization
-[eva] tests/libc/fc_libc.c:160: assertion got status valid.
-[eva] tests/libc/fc_libc.c:161: assertion got status valid.
-[eva] tests/libc/fc_libc.c:162: assertion got status valid.
-[eva] tests/libc/fc_libc.c:163: assertion got status valid.
+[eva] tests/libc/fc_libc.c:148: assertion got status valid.
+[eva] tests/libc/fc_libc.c:149: assertion got status valid.
+[eva] tests/libc/fc_libc.c:150: assertion got status valid.
+[eva] tests/libc/fc_libc.c:151: assertion got status valid.
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
[eva:final-states] Values at end of function main:
-[metrics] Defined functions (73)
+[metrics] Defined functions (76)
======================
Frama_C_double_interval (0 call); Frama_C_float_interval (0 call);
- Frama_C_interval (13 calls); Frama_C_nondet (11 calls);
+ Frama_C_interval (14 calls); Frama_C_nondet (12 calls);
Frama_C_nondet_ptr (0 call); __FC_assert (0 call); __fc_initenv (4 calls);
__finite (0 call); __finitef (0 call); abs (0 call); atoi (0 call);
calloc (0 call); char_equal_ignore_case (1 call); fabs (0 call);
fabsf (0 call); feholdexcept (0 call); fesetenv (0 call);
fetestexcept (0 call); getaddrinfo (0 call); getenv (0 call);
- getline (0 call); glob (0 call); globfree (0 call); imaxabs (0 call);
- imaxdiv (0 call); isalnum (0 call); isalpha (0 call); isblank (0 call);
- iscntrl (0 call); isdigit (3 calls); isgraph (0 call); islower (0 call);
- isprint (0 call); ispunct (0 call); isspace (1 call); isupper (0 call);
- isxdigit (0 call); localeconv (0 call); main (0 call); memchr (0 call);
- memcmp (0 call); memcpy (2 calls); memmove (0 call); memrchr (0 call);
- memset (1 call); putenv (0 call); setenv (0 call); setlocale (0 call);
+ gethostbyname (0 call); getline (0 call); glob (0 call); globfree (0 call);
+ imaxabs (0 call); imaxdiv (0 call); isalnum (0 call); isalpha (0 call);
+ isblank (0 call); iscntrl (0 call); isdigit (3 calls); isgraph (0 call);
+ islower (0 call); isprint (0 call); ispunct (0 call); isspace (1 call);
+ isupper (0 call); isxdigit (0 call); localeconv (0 call); main (0 call);
+ memchr (0 call); memcmp (0 call); memcpy (4 calls); memmove (0 call);
+ memrchr (0 call); memset (1 call); posix_memalign (0 call); putenv (0 call);
+ res_search (1 call); setenv (0 call); setlocale (0 call);
strcasecmp (0 call); strcat (0 call); strchr (3 calls); strcmp (0 call);
strcpy (0 call); strdup (0 call); strerror (0 call); strlen (6 calls);
- strncat (0 call); strncmp (0 call); strncpy (0 call); strndup (0 call);
+ strncat (0 call); strncmp (0 call); strncpy (2 calls); strndup (0 call);
strnlen (0 call); strrchr (0 call); strstr (0 call); tolower (0 call);
toupper (0 call); unsetenv (0 call); wcscat (0 call); wcscpy (0 call);
wcslen (2 calls); wcsncat (0 call); wcsncpy (0 call); wmemcpy (0 call);
wmemset (0 call);
- Undefined functions (358)
+ Undefined functions (360)
=========================
FD_CLR (0 call); FD_ISSET (0 call); FD_SET (0 call); FD_ZERO (0 call);
- Frama_C_abort (1 call); Frama_C_char_interval (0 call);
+ Frama_C_abort (1 call); Frama_C_char_interval (1 call);
Frama_C_int_interval (0 call); Frama_C_long_interval (0 call);
Frama_C_long_long_interval (0 call); Frama_C_make_unknown (2 calls);
Frama_C_real_interval_as_double (0 call); Frama_C_short_interval (0 call);
@@ -69,41 +70,42 @@
alloca (0 call); asin (0 call); asinf (0 call); asinl (0 call);
at_quick_exit (0 call); atan (0 call); atan2 (0 call); atan2f (0 call);
atanf (0 call); atanl (0 call); atexit (0 call); atof (0 call);
- atol (0 call); atoll (0 call); bind (0 call); bsearch (0 call);
- bzero (0 call); ceil (0 call); ceilf (0 call); ceill (0 call);
- clearerr (0 call); clearerr_unlocked (0 call); clock (0 call);
- clock_gettime (0 call); clock_nanosleep (0 call); close (0 call);
- closedir (0 call); closelog (0 call); connect (0 call); cos (0 call);
- cosf (0 call); cosl (0 call); creat (0 call); ctime (0 call);
- difftime (0 call); div (0 call); dup (0 call); dup2 (0 call);
- execl (0 call); execle (0 call); execlp (0 call); execv (0 call);
- execve (0 call); execvp (0 call); exit (0 call); exp (0 call);
- expf (0 call); fabsl (0 call); fclose (0 call); fcntl (0 call);
- fdopen (0 call); feof (2 calls); feof_unlocked (0 call); ferror (2 calls);
- ferror_unlocked (0 call); fflush (0 call); fgetc (1 call); fgetpos (0 call);
- fgets (0 call); fgetws (0 call); fileno (0 call); fileno_unlocked (0 call);
- flock (0 call); flockfile (0 call); floor (0 call); floorf (0 call);
- floorl (0 call); fmod (0 call); fmodf (0 call); fopen (0 call);
- fork (0 call); fputc (0 call); fputs (0 call); fread (0 call);
- free (1 call); freeaddrinfo (0 call); freopen (0 call); fseek (0 call);
- fsetpos (0 call); ftell (0 call); ftrylockfile (0 call);
- funlockfile (0 call); fwrite (0 call); gai_strerror (0 call); getc (0 call);
- getc_unlocked (0 call); getchar (0 call); getchar_unlocked (0 call);
- getcwd (0 call); getegid (0 call); geteuid (0 call); getgid (0 call);
- gethostname (0 call); getitimer (0 call); getopt (0 call);
- getopt_long (0 call); getopt_long_only (0 call); getpid (0 call);
- getppid (0 call); getpriority (0 call); getpwuid (0 call);
- getresgid (0 call); getresuid (0 call); getrlimit (0 call);
- getrusage (0 call); gets (0 call); getsid (0 call); getsockopt (0 call);
- gettimeofday (0 call); getuid (0 call); gmtime (0 call); htonl (0 call);
- htons (0 call); iconv (0 call); iconv_close (0 call); iconv_open (0 call);
- inet_addr (0 call); inet_ntoa (0 call); inet_ntop (0 call);
+ atol (0 call); atoll (0 call); basename (0 call); bind (0 call);
+ bsearch (0 call); bzero (0 call); ceil (0 call); ceilf (0 call);
+ ceill (0 call); clearerr (0 call); clearerr_unlocked (0 call);
+ clock (0 call); clock_gettime (0 call); clock_nanosleep (0 call);
+ close (0 call); closedir (0 call); closelog (0 call); connect (0 call);
+ cos (0 call); cosf (0 call); cosl (0 call); creat (0 call); ctime (0 call);
+ difftime (0 call); dirname (0 call); div (0 call); dup (0 call);
+ dup2 (0 call); execl (0 call); execle (0 call); execlp (0 call);
+ execv (0 call); execve (0 call); execvp (0 call); exit (0 call);
+ exp (0 call); expf (0 call); fabsl (0 call); fclose (0 call);
+ fcntl (0 call); fdopen (0 call); feof (2 calls); feof_unlocked (0 call);
+ ferror (2 calls); ferror_unlocked (0 call); fflush (0 call); fgetc (1 call);
+ fgetpos (0 call); fgets (0 call); fgetws (0 call); fileno (0 call);
+ fileno_unlocked (0 call); flock (0 call); flockfile (0 call);
+ floor (0 call); floorf (0 call); floorl (0 call); fmod (0 call);
+ fmodf (0 call); fopen (0 call); fork (0 call); fputc (0 call);
+ fputs (0 call); fread (0 call); free (1 call); freeaddrinfo (0 call);
+ freopen (0 call); fseek (0 call); fsetpos (0 call); ftell (0 call);
+ ftrylockfile (0 call); funlockfile (0 call); fwrite (0 call);
+ gai_strerror (0 call); getc (0 call); getc_unlocked (0 call);
+ getchar (0 call); getchar_unlocked (0 call); getcwd (0 call);
+ getegid (0 call); geteuid (0 call); getgid (0 call); gethostname (0 call);
+ getitimer (0 call); getopt (0 call); getopt_long (0 call);
+ getopt_long_only (0 call); getpid (0 call); getppid (0 call);
+ getpriority (0 call); getpwuid (0 call); getresgid (0 call);
+ getresuid (0 call); getrlimit (0 call); getrusage (0 call); gets (0 call);
+ getsid (0 call); getsockopt (0 call); gettimeofday (0 call);
+ getuid (0 call); gmtime (0 call); htonl (0 call); htons (0 call);
+ iconv (0 call); iconv_close (0 call); iconv_open (0 call);
+ inet_addr (2 calls); inet_ntoa (0 call); inet_ntop (0 call);
inet_pton (0 call); isascii (0 call); kill (0 call); labs (0 call);
ldiv (0 call); listen (0 call); llabs (0 call); lldiv (0 call);
localtime (0 call); log (0 call); log10 (0 call); log10f (0 call);
log10l (0 call); log2 (0 call); log2f (0 call); log2l (0 call);
logf (0 call); logl (0 call); longjmp (0 call); lrand48 (0 call);
- malloc (6 calls); mblen (0 call); mbstowcs (0 call); mbtowc (0 call);
+ malloc (7 calls); mblen (0 call); mbstowcs (0 call); mbtowc (0 call);
memoverlap (1 call); mkdir (0 call); mktime (0 call); nan (0 call);
nanf (0 call); nanl (0 call); nanosleep (0 call); ntohl (0 call);
ntohs (0 call); open (0 call); openat (0 call); opendir (0 call);
@@ -148,12 +150,12 @@
wcsstr (0 call); wcstombs (0 call); wctomb (0 call); wmemchr (0 call);
wmemcmp (0 call); wmemmove (0 call); write (0 call);
- 'Extern' global variables (15)
+ 'Extern' global variables (17)
==============================
- __fc_getpwuid_pw_dir; __fc_getpwuid_pw_gid; __fc_getpwuid_pw_name;
- __fc_getpwuid_pw_passwd; __fc_getpwuid_pw_shell; __fc_getpwuid_pw_uid;
- __fc_hostname; __fc_mblen_state; __fc_mbtowc_state; __fc_strerror;
- __fc_wctomb_state; optarg; opterr; optopt; tzname
+ __fc_basename; __fc_dirname; __fc_getpwuid_pw_dir; __fc_getpwuid_pw_gid;
+ __fc_getpwuid_pw_name; __fc_getpwuid_pw_passwd; __fc_getpwuid_pw_shell;
+ __fc_getpwuid_pw_uid; __fc_hostname; __fc_mblen_state; __fc_mbtowc_state;
+ __fc_strerror; __fc_wctomb_state; optarg; opterr; optopt; tzname
Potential entry points (1)
==========================
@@ -161,18 +163,18 @@
Global metrics
==============
- Sloc = 948
- Decision point = 183
- Global variables = 54
- If = 174
- Loop = 40
- Goto = 78
- Assignment = 379
- Exit point = 73
- Function = 431
- Function call = 73
- Pointer dereferencing = 146
- Cyclomatic complexity = 256
+ Sloc = 1026
+ Decision point = 195
+ Global variables = 59
+ If = 186
+ Loop = 42
+ Goto = 84
+ Assignment = 415
+ Exit point = 76
+ Function = 436
+ Function call = 84
+ Pointer dereferencing = 157
+ Cyclomatic complexity = 271
/* Generated by Frama-C */
#include "__fc_builtin.c"
#include "__fc_builtin.h"
@@ -193,6 +195,7 @@
#include "glob.h"
#include "iconv.h"
#include "inttypes.h"
+#include "libgen.h"
#include "locale.c"
#include "locale.h"
#include "math.c"
diff --git a/tests/libc/oracle/fc_libc.1.res.oracle b/tests/libc/oracle/fc_libc.1.res.oracle
index 388b254dc2a9885eae3ae4b6709ec8d78e129fab..8fbee9224b0558cc49a4f482ba14631703f85fe3 100644
--- a/tests/libc/oracle/fc_libc.1.res.oracle
+++ b/tests/libc/oracle/fc_libc.1.res.oracle
@@ -184,6 +184,13 @@ enum __anonenum_22 {
IPPROTO_RAW = 255,
IPPROTO_MAX = 256
};
+struct hostent {
+ char *h_name ;
+ char **h_aliases ;
+ int h_addrtype ;
+ int h_length ;
+ char **h_addr_list ;
+};
struct addrinfo {
int ai_flags ;
int ai_family ;
@@ -194,6 +201,13 @@ struct addrinfo {
char *ai_canonname ;
struct addrinfo *ai_next ;
};
+struct __fc_gethostbyname {
+ struct hostent host ;
+ unsigned char host_addr[sizeof(struct in_addr)] ;
+ char *h_addr_ptrs[2 + 1] ;
+ char *host_aliases[2] ;
+ char hostbuf[128] ;
+};
typedef void * const * va_list;
typedef unsigned int ino_t;
typedef long time_t;
@@ -261,7 +275,7 @@ struct DIR {
};
typedef struct DIR DIR;
struct __anonstruct_fd_set_25 {
- char __fc_fd_set ;
+ long __fc_fd_set[(unsigned int)1024 / ((unsigned int)8 * sizeof(long))] ;
};
typedef struct __anonstruct_fd_set_25 fd_set;
typedef unsigned int useconds_t;
@@ -1906,6 +1920,8 @@ extern size_t mbstowcs(wchar_t * __restrict pwcs, char const * __restrict s,
extern size_t wcstombs(char * __restrict s, wchar_t const * __restrict pwcs,
size_t n);
+int posix_memalign(void **memptr, size_t alignment, size_t size);
+
int glob(char const *pattern, int flags,
int (*errfunc)(char const *epath, int eerrno), glob_t *pglob)
{
@@ -3228,836 +3244,929 @@ int getaddrinfo(char const * __restrict nodename,
struct addrinfo const * __restrict hints,
struct addrinfo ** __restrict res);
-static unsigned int volatile getaddrinfo_net_state;
-/*@ requires
- nodename_string: nodename ≡ \null ∨ valid_read_string(nodename);
- requires
- servname_string: servname ≡ \null ∨ valid_read_string(servname);
- requires hints_option: hints ≡ \null ∨ \valid_read(hints);
- requires valid_res: \valid(res);
- assigns *res, \result, __fc_errno;
- assigns *res
- \from (indirect: nodename), (indirect: servname), (indirect: hints);
- assigns \result
- \from (indirect: nodename), (indirect: servname), (indirect: hints);
- assigns __fc_errno
- \from (indirect: nodename), (indirect: servname), (indirect: hints);
- allocates *\old(res);
-
- behavior empty_request:
- assumes empty: nodename ≡ \null ∧ servname ≡ \null;
- ensures no_name: \result ≡ -2;
- assigns \result;
- assigns \result \from (indirect: nodename), (indirect: servname);
-
- behavior normal_request:
- assumes has_name: nodename ≢ \null ∨ servname ≢ \null;
- ensures
- initialization: allocation: success_or_error:
- (\result ≡ 0 ∧
- \fresh{Old, Here}(*\old(res),sizeof(*\old(res))) ∧
- \initialized(*\old(res))) ∨
- \result ≡ -3 ∨ \result ≡ -1 ∨ \result ≡ -4 ∨
- \result ≡ -6 ∨ \result ≡ -10 ∨ \result ≡ -8 ∨
- \result ≡ -7 ∨ \result ≡ -11;
-
- complete behaviors normal_request, empty_request;
- disjoint behaviors normal_request, empty_request;
+struct hostent *gethostbyname(char const *name);
+
+/*@
+predicate non_escaping{L}(void *s, size_t n) =
+ ∀ unsigned int i; 0 ≤ i < n ⇒ ¬\dangling((char *)s + i);
*/
-int getaddrinfo(char const * __restrict nodename,
- char const * __restrict servname,
- struct addrinfo const * __restrict hints,
- struct addrinfo ** __restrict res)
-{
- int __retres;
- if (nodename == (char const *)0)
- if (servname == (char const *)0) {
- __retres = -2;
- goto return_label;
- }
- switch (getaddrinfo_net_state) {
- case (unsigned int)0: __retres = -1;
- goto return_label;
- case (unsigned int)1: __retres = -3;
- goto return_label;
- case (unsigned int)2: __retres = -4;
- goto return_label;
- case (unsigned int)3: __retres = -6;
- goto return_label;
- case (unsigned int)5: __retres = -8;
- goto return_label;
- case (unsigned int)6: __retres = -7;
- goto return_label;
- case (unsigned int)7:
- {
- __fc_errno = 5;
- __retres = -11;
- goto return_label;
- }
- default:
- {
- struct addrinfo *tmp_0;
- struct sockaddr *tmp_2;
- int tmp_3;
- struct addrinfo *ai = malloc(sizeof(*tmp_0));
- if (! ai) {
- __retres = -10;
- goto return_label;
- }
- struct sockaddr *sa = malloc(sizeof(*tmp_2));
- if (! sa) {
- __retres = -10;
- goto return_label;
- }
- tmp_3 = Frama_C_interval(0,43);
- sa->sa_family = (unsigned short)tmp_3;
- /*@ slevel 15; */
- {
- int i = 0;
- while (i < 14) {
- {
- int tmp_4;
- tmp_4 = Frama_C_interval(-128,127);
- sa->sa_data[i] = (char)tmp_4;
- }
- i ++;
- }
- }
- /*@ slevel default; */
- ai->ai_flags = 0;
- ai->ai_family = (int)sa->sa_family;
- ai->ai_socktype = Frama_C_interval(0,5);
- ai->ai_protocol = Frama_C_interval(0,IPPROTO_MAX);
- ai->ai_addrlen = sizeof(*sa);
- ai->ai_addr = sa;
- ai->ai_canonname = (char *)"dummy";
- ai->ai_next = (struct addrinfo *)0;
- *res = ai;
- __retres = 0;
- goto return_label;
- }
- }
- return_label: return __retres;
-}
+/*@
+predicate empty_block{L}(void *s) =
+ \block_length((char *)s) ≡ 0 ∧ \offset((char *)s) ≡ 0;
+ */
+/*@
+predicate valid_or_empty{L}(void *s, size_t n) =
+ (empty_block(s) ∨ \valid_read((char *)s)) ∧
+ \valid((char *)s + (0 .. n - 1));
+ */
+/*@
+predicate valid_read_or_empty{L}(void *s, size_t n) =
+ (empty_block(s) ∨ \valid_read((char *)s)) ∧
+ \valid_read((char *)s + (1 .. n - 1));
-FILE *__fc_stderr;
+*/
+int memcmp(void const *s1, void const *s2, size_t n);
-FILE *__fc_stdin;
+void *memchr(void const *s, int c, size_t n);
-FILE *__fc_stdout;
+void *memcpy(void * __restrict dest, void const * __restrict src, size_t n);
-/*@ assigns \nothing; */
-extern int remove(char const *filename);
+void *memmove(void *dest, void const *src, size_t n);
-/*@ assigns \nothing; */
-extern int rename(char const *old_name, char const *new_name);
+void *memset(void *s, int c, size_t n);
-FILE __fc_fopen[16];
-FILE * const __fc_p_fopen = __fc_fopen;
-/*@ ensures
- result_null_or_valid_fd:
- \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
- assigns \result;
- assigns \result \from __fc_p_fopen;
- */
-extern FILE *tmpfile(void);
+size_t strlen(char const *s);
-/*@ assigns \result, *(s + (..));
- assigns \result \from *(s + (..));
- assigns *(s + (..)) \from \nothing;
- */
-extern char *tmpnam(char *s);
+size_t strnlen(char const *s, size_t maxlen);
-/*@ requires valid_stream: \valid(stream);
- ensures result_zero_or_EOF: \result ≡ 0 ∨ \result ≡ -1;
- assigns \result;
- assigns \result \from stream, stream->__fc_FILE_id;
- */
-extern int fclose(FILE *stream);
+int strcmp(char const *s1, char const *s2);
-/*@ requires null_or_valid_stream: stream ≡ \null ∨ \valid_read(stream);
- ensures result_zero_or_EOF: \result ≡ 0 ∨ \result ≡ -1;
+int strncmp(char const *s1, char const *s2, size_t n);
+
+/*@ requires valid_string_s1: valid_read_string(s1);
+ requires valid_string_s2: valid_read_string(s2);
assigns \result;
- assigns \result \from stream, stream->__fc_FILE_id;
+ assigns \result
+ \from (indirect: *(s1 + (0 ..))), (indirect: *(s2 + (0 ..)));
*/
-extern int fflush(FILE *stream);
+extern int strcoll(char const *s1, char const *s2);
-/*@ requires valid_filename: valid_read_string(filename);
- requires valid_mode: valid_read_string(mode);
- ensures
- result_null_or_valid_fd:
- \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
+char *strchr(char const *s, int c);
+
+char *strrchr(char const *s, int c);
+
+/*@ requires valid_string_s: valid_read_string(s);
+ requires valid_string_reject: valid_read_string(reject);
+ ensures result_bounded: 0 ≤ \result ≤ strlen(\old(s));
assigns \result;
assigns \result
- \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
- __fc_p_fopen;
+ \from (indirect: *(s + (0 ..))), (indirect: *(reject + (0 ..)));
*/
-extern FILE *fopen(char const * __restrict filename,
- char const * __restrict mode);
+extern size_t strcspn(char const *s, char const *reject);
-/*@ requires valid_mode: valid_read_string(mode);
- ensures
- result_null_or_valid_fd:
- \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
- assigns \result, __fc_fopen[fd];
+/*@ requires valid_string_s: valid_read_string(s);
+ requires valid_string_accept: valid_read_string(accept);
+ ensures result_bounded: 0 ≤ \result ≤ strlen(\old(s));
+ assigns \result, \result;
+ assigns \result \from *(s + (0 ..)), *(accept + (0 ..));
assigns \result
- \from (indirect: fd), (indirect: *(mode + (0 ..))),
- (indirect: __fc_fopen[fd]), __fc_p_fopen;
- assigns __fc_fopen[fd]
- \from (indirect: fd), (indirect: *(mode + (0 ..))),
- (indirect: __fc_fopen[fd]), __fc_p_fopen;
+ \from (indirect: *(s + (0 ..))), (indirect: *(accept + (0 ..)));
*/
-extern FILE *fdopen(int fd, char const *mode);
+extern size_t strspn(char const *s, char const *accept);
-/*@ requires valid_filename: valid_read_string(filename);
- requires valid_mode: valid_read_string(mode);
- requires valid_stream: \valid(stream);
+/*@ requires valid_string_s: valid_read_string(s);
+ requires valid_string_accept: valid_read_string(accept);
ensures
- result_null_or_valid_fd:
- \result ≡ \null ∨ \result ∈ &__fc_fopen[0 .. 16 - 1];
- ensures stream_opened: *\old(stream) ∈ __fc_fopen[0 .. 16 - 1];
- assigns \result, *stream;
- assigns \result
- \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
- __fc_p_fopen, (indirect: stream);
- assigns *stream
- \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
- __fc_p_fopen, (indirect: stream);
+ result_null_or_same_base:
+ \result ≡ \null ∨ \base_addr(\result) ≡ \base_addr(\old(s));
+ assigns \result;
+ assigns \result \from s, *(s + (0 ..)), *(accept + (0 ..));
*/
-extern FILE *freopen(char const * __restrict filename,
- char const * __restrict mode, FILE * __restrict stream);
-
-/*@ assigns *stream;
- assigns *stream \from buf; */
-extern void setbuf(FILE * __restrict stream, char * __restrict buf);
-
-/*@ assigns *stream;
- assigns *stream \from buf, mode, size; */
-extern int setvbuf(FILE * __restrict stream, char * __restrict buf, int mode,
- size_t size);
-
-/*@ axiomatic format_length {
- logic ℤ format_length{L}(char *format) ;
-
- }
+extern char *strpbrk(char const *s, char const *accept);
-*/
-/*@ assigns *stream;
- assigns *stream \from *(format + (..)), arg; */
-extern int vfprintf(FILE * __restrict stream, char const * __restrict format,
- va_list arg);
+char *strstr(char const *haystack, char const *needle);
-/*@ assigns *stream;
- assigns *stream \from *(format + (..)), *stream; */
-extern int vfscanf(FILE * __restrict stream, char const * __restrict format,
- va_list arg);
-
-/*@ assigns *__fc_stdout;
- assigns *__fc_stdout \from arg; */
-extern int vprintf(char const * __restrict format, va_list arg);
-
-/*@ assigns *__fc_stdin;
- assigns *__fc_stdin \from *(format + (..)); */
-extern int vscanf(char const * __restrict format, va_list arg);
-
-/*@ assigns *(s + (0 .. n - 1));
- assigns *(s + (0 .. n - 1)) \from *(format + (..)), arg;
- */
-extern int vsnprintf(char * __restrict s, size_t n,
- char const * __restrict format, va_list arg);
-
-/*@ assigns *(s + (0 ..));
- assigns *(s + (0 ..)) \from *(format + (..)), arg;
+char *__fc_strtok_ptr;
+/*@ requires valid_string_delim: valid_read_string(delim);
+ assigns *(s + (0 ..)), *(__fc_strtok_ptr + (0 ..)), \result,
+ __fc_strtok_ptr;
+ assigns *(s + (0 ..))
+ \from *(s + (0 ..)), (indirect: s), (indirect: __fc_strtok_ptr),
+ (indirect: *(delim + (0 ..)));
+ assigns *(__fc_strtok_ptr + (0 ..))
+ \from *(__fc_strtok_ptr + (0 ..)), (indirect: s),
+ (indirect: __fc_strtok_ptr), (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from s, __fc_strtok_ptr, (indirect: *(s + (0 ..))),
+ (indirect: *(__fc_strtok_ptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+ assigns __fc_strtok_ptr
+ \from \old(__fc_strtok_ptr), s,
+ (indirect: *(__fc_strtok_ptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+
+ behavior new_str:
+ assumes s_not_null: s ≢ \null;
+ requires
+ valid_string_s_or_delim_not_found:
+ valid_string(s) ∨
+ (valid_read_string(s) ∧
+ (∀ int i;
+ 0 ≤ i < strlen(delim) ⇒
+ ¬(strchr(s, *(delim + i)) ≡ \true)));
+ ensures
+ result_subset:
+ \result ≡ \null ∨ \subset(\result, \old(s) + (0 ..));
+ ensures ptr_subset: \subset(__fc_strtok_ptr, \old(s) + (0 ..));
+ assigns __fc_strtok_ptr, *(s + (0 ..)), \result;
+ assigns __fc_strtok_ptr
+ \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
+ assigns *(s + (0 ..))
+ \from *(s + (0 ..)), (indirect: s), (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
+
+ behavior resume_str:
+ assumes s_null: s ≡ \null;
+ requires not_first_call: __fc_strtok_ptr ≢ \null;
+ ensures
+ result_subset:
+ \result ≡ \null ∨
+ \subset(\result, \old(__fc_strtok_ptr) + (0 ..));
+ ensures
+ ptr_subset: \subset(__fc_strtok_ptr, \old(__fc_strtok_ptr) + (0 ..));
+ assigns *(__fc_strtok_ptr + (0 ..)), __fc_strtok_ptr, \result;
+ assigns *(__fc_strtok_ptr + (0 ..))
+ \from *(__fc_strtok_ptr + (0 ..)), (indirect: __fc_strtok_ptr),
+ (indirect: *(delim + (0 ..)));
+ assigns __fc_strtok_ptr
+ \from \old(__fc_strtok_ptr), (indirect: *(__fc_strtok_ptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from __fc_strtok_ptr, (indirect: *(__fc_strtok_ptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+
+ complete behaviors resume_str, new_str;
+ disjoint behaviors resume_str, new_str;
*/
-extern int vsprintf(char * __restrict s, char const * __restrict format,
- va_list arg);
+extern char *strtok(char * __restrict s, char const * __restrict delim);
-/*@ requires valid_stream: \valid(stream);
- ensures result_uchar_or_eof: (0 ≤ \result ≤ 255) ∨ \result ≡ -1;
- assigns *stream, \result;
- assigns *stream \from *stream;
- assigns \result \from (indirect: *stream);
+/*@ requires valid_string_delim: valid_read_string(delim);
+ requires valid_saveptr: \valid(saveptr);
+ assigns *(s + (0 ..)), *(*saveptr + (0 ..)), \result, *saveptr;
+ assigns *(s + (0 ..))
+ \from *(s + (0 ..)), (indirect: s), (indirect: *saveptr),
+ (indirect: *(delim + (0 ..)));
+ assigns *(*saveptr + (0 ..))
+ \from *(*saveptr + (0 ..)), (indirect: s), (indirect: *saveptr),
+ (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from s, *saveptr, (indirect: *(s + (0 ..))),
+ (indirect: *(*saveptr + (0 ..))), (indirect: *(delim + (0 ..)));
+ assigns *saveptr
+ \from \old(*saveptr), s, (indirect: *(*saveptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+
+ behavior new_str:
+ assumes s_not_null: s ≢ \null;
+ requires
+ valid_string_s_or_delim_not_found:
+ valid_string(s) ∨
+ (valid_read_string(s) ∧
+ (∀ int i;
+ 0 ≤ i < strlen(delim) ⇒
+ ¬(strchr(s, *(delim + i)) ≡ \true)));
+ ensures
+ result_subset:
+ \result ≡ \null ∨ \subset(\result, \old(s) + (0 ..));
+ ensures initialization: \initialized(\old(saveptr));
+ ensures saveptr_subset: \subset(*\old(saveptr), \old(s) + (0 ..));
+ assigns *saveptr, *(s + (0 ..)), \result;
+ assigns *saveptr
+ \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
+ assigns *(s + (0 ..))
+ \from *(s + (0 ..)), (indirect: s), (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
+
+ behavior resume_str:
+ assumes s_null: s ≡ \null;
+ requires not_first_call: *saveptr ≢ \null;
+ requires initialization: saveptr: \initialized(saveptr);
+ ensures
+ result_subset:
+ \result ≡ \null ∨ \subset(\result, \old(*saveptr) + (0 ..));
+ ensures
+ saveptr_subset: \subset(*\old(saveptr), \old(*saveptr) + (0 ..));
+ assigns *(*saveptr + (0 ..)), *saveptr, \result;
+ assigns *(*saveptr + (0 ..))
+ \from *(*saveptr + (0 ..)), (indirect: *saveptr),
+ (indirect: *(delim + (0 ..)));
+ assigns *saveptr
+ \from \old(*saveptr), (indirect: *(*saveptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+ assigns \result
+ \from *saveptr, (indirect: *(*saveptr + (0 ..))),
+ (indirect: *(delim + (0 ..)));
+
+ complete behaviors resume_str, new_str;
+ disjoint behaviors resume_str, new_str;
*/
-extern int fgetc(FILE *stream);
+extern char *strtok_r(char * __restrict s, char const * __restrict delim,
+ char ** __restrict saveptr);
-/*@ requires valid_stream: \valid(stream);
- ensures result_null_or_same: \result ≡ \null ∨ \result ≡ \old(s);
- ensures
- terminated_string_on_success:
- \result ≢ \null ⇒ valid_string(\old(s));
- assigns *(s + (0 .. size)), \result;
- assigns *(s + (0 .. size)) \from (indirect: size), (indirect: *stream);
- assigns \result \from s, (indirect: size), (indirect: *stream);
+/*@ requires
+ valid_string_stringp: \valid(stringp) ∧ valid_string(*stringp);
+ requires valid_string_delim: valid_read_string(delim);
+ assigns *stringp, \result;
+ assigns *stringp \from *(delim + (..)), *(*(stringp + (..)));
+ assigns \result \from *(delim + (..)), *(*(stringp + (..)));
*/
-extern char *fgets(char * __restrict s, int size, FILE * __restrict stream);
+extern char *strsep(char **stringp, char const *delim);
-/*@ assigns *stream; */
-extern int fputc(int c, FILE *stream);
+extern char __fc_strerror[64];
-/*@ assigns *stream;
- assigns *stream \from *(s + (..)); */
-extern int fputs(char const * __restrict s, FILE * __restrict stream);
+char * const __fc_p_strerror = __fc_strerror;
+char *strerror(int errnum);
-/*@ assigns \result, *stream;
- assigns \result \from *stream;
- assigns *stream \from *stream;
- */
-extern int getc(FILE *stream);
+char *strcpy(char *dest, char const *src);
-/*@ assigns \result;
- assigns \result \from *__fc_stdin; */
-extern int getchar(void);
+char *strncpy(char *dest, char const *src, size_t n);
-/*@ ensures result_null_or_same: \result ≡ \old(s) ∨ \result ≡ \null;
- assigns *(s + (..)), \result;
- assigns *(s + (..)) \from *__fc_stdin;
- assigns \result \from s, __fc_stdin;
- */
-extern char *gets(char *s);
+char *strcat(char *dest, char const *src);
-/*@ assigns *stream;
- assigns *stream \from c; */
-extern int putc(int c, FILE *stream);
+char *strncat(char *dest, char const *src, size_t n);
-/*@ assigns *__fc_stdout;
- assigns *__fc_stdout \from c; */
-extern int putchar(int c);
+/*@ requires valid_dest: \valid(dest + (0 .. n - 1));
+ requires valid_string_src: valid_read_string(src);
+ assigns *(dest + (0 .. n - 1)), \result;
+ assigns *(dest + (0 .. n - 1))
+ \from (indirect: *(src + (0 ..))), (indirect: n);
+ assigns \result \from dest;
+ */
+extern size_t strxfrm(char * __restrict dest, char const * __restrict src,
+ size_t n);
-/*@ assigns *__fc_stdout;
- assigns *__fc_stdout \from *(s + (..)); */
-extern int puts(char const *s);
+char *strdup(char const *s);
-/*@ assigns *stream;
- assigns *stream \from c; */
-extern int ungetc(int c, FILE *stream);
+char *strndup(char const *s, size_t n);
-/*@ requires valid_ptr_block: \valid((char *)ptr + (0 .. nmemb * size - 1));
- requires valid_stream: \valid(stream);
- ensures size_read: \result ≤ \old(nmemb);
+/*@ requires valid_memory_area: \valid((char *)s + (0 .. n - 1));
ensures
- initialization:
- \initialized((char *)\old(ptr) + (0 .. \result * \old(size) - 1));
- assigns *((char *)ptr + (0 .. nmemb * size - 1)), \result;
- assigns *((char *)ptr + (0 .. nmemb * size - 1))
- \from size, nmemb, *stream;
- assigns \result \from size, *stream;
+ s_initialized: initialization:
+ \initialized((char *)\old(s) + (0 .. \old(n) - 1));
+ ensures
+ zero_initialized: \subset(*((char *)\old(s) + (0 .. \old(n) - 1)), {0});
+ assigns *((char *)s + (0 .. n - 1));
+ assigns *((char *)s + (0 .. n - 1)) \from \nothing;
*/
-extern size_t fread(void * __restrict ptr, size_t size, size_t nmemb,
- FILE * __restrict stream);
+extern void bzero(void *s, size_t n);
-/*@ requires
- valid_ptr_block: \valid_read((char *)ptr + (0 .. nmemb * size - 1));
- requires valid_stream: \valid(stream);
- ensures size_written: \result ≤ \old(nmemb);
- assigns *stream, \result;
- assigns *stream \from *((char *)ptr + (0 .. nmemb * size - 1));
- assigns \result \from *((char *)ptr + (0 .. nmemb * size - 1));
- */
-extern size_t fwrite(void const * __restrict ptr, size_t size, size_t nmemb,
- FILE * __restrict stream);
+int strcasecmp(char const *s1, char const *s2);
-/*@ assigns *pos;
- assigns *pos \from *stream; */
-extern int fgetpos(FILE * __restrict stream, fpos_t * __restrict pos);
+/*@ requires valid_string_s1: valid_read_nstring(s1, n);
+ requires valid_string_s2: valid_read_nstring(s2, n);
+ assigns \result;
+ assigns \result
+ \from (indirect: n), (indirect: *(s1 + (0 .. n - 1))),
+ (indirect: *(s2 + (0 .. n - 1)));
+ */
+extern int strncasecmp(char const *s1, char const *s2, size_t n);
-/*@ requires valid_stream: \valid(stream);
- requires whence_enum: whence ≡ 0 ∨ whence ≡ 1 ∨ whence ≡ 2;
- assigns *stream, \result, __fc_errno;
- assigns *stream \from *stream, (indirect: offset), (indirect: whence);
+static unsigned int volatile getaddrinfo_net_state;
+/*@ requires
+ nodename_string: nodename ≡ \null ∨ valid_read_string(nodename);
+ requires
+ servname_string: servname ≡ \null ∨ valid_read_string(servname);
+ requires hints_option: hints ≡ \null ∨ \valid_read(hints);
+ requires valid_res: \valid(res);
+ assigns *res, \result, __fc_errno;
+ assigns *res
+ \from (indirect: nodename), (indirect: servname), (indirect: hints);
assigns \result
- \from (indirect: *stream), (indirect: offset), (indirect: whence);
+ \from (indirect: nodename), (indirect: servname), (indirect: hints);
assigns __fc_errno
- \from (indirect: *stream), (indirect: offset), (indirect: whence);
+ \from (indirect: nodename), (indirect: servname), (indirect: hints);
+ allocates *\old(res);
+
+ behavior empty_request:
+ assumes empty: nodename ≡ \null ∧ servname ≡ \null;
+ ensures no_name: \result ≡ -2;
+ assigns \result;
+ assigns \result \from (indirect: nodename), (indirect: servname);
+
+ behavior normal_request:
+ assumes has_name: nodename ≢ \null ∨ servname ≢ \null;
+ ensures
+ initialization: allocation: success_or_error:
+ (\result ≡ 0 ∧
+ \fresh{Old, Here}(*\old(res),sizeof(*\old(res))) ∧
+ \initialized(*\old(res))) ∨
+ \result ≡ -3 ∨ \result ≡ -1 ∨ \result ≡ -4 ∨
+ \result ≡ -6 ∨ \result ≡ -10 ∨ \result ≡ -8 ∨
+ \result ≡ -7 ∨ \result ≡ -11;
+
+ complete behaviors normal_request, empty_request;
+ disjoint behaviors normal_request, empty_request;
*/
-extern int fseek(FILE *stream, long offset, int whence);
+int getaddrinfo(char const * __restrict nodename,
+ char const * __restrict servname,
+ struct addrinfo const * __restrict hints,
+ struct addrinfo ** __restrict res)
+{
+ int __retres;
+ if (nodename == (char const *)0)
+ if (servname == (char const *)0) {
+ __retres = -2;
+ goto return_label;
+ }
+ switch (getaddrinfo_net_state) {
+ case (unsigned int)0: __retres = -1;
+ goto return_label;
+ case (unsigned int)1: __retres = -3;
+ goto return_label;
+ case (unsigned int)2: __retres = -4;
+ goto return_label;
+ case (unsigned int)3: __retres = -6;
+ goto return_label;
+ case (unsigned int)5: __retres = -8;
+ goto return_label;
+ case (unsigned int)6: __retres = -7;
+ goto return_label;
+ case (unsigned int)7:
+ {
+ __fc_errno = 5;
+ __retres = -11;
+ goto return_label;
+ }
+ default:
+ {
+ struct addrinfo *tmp_0;
+ struct sockaddr *tmp_2;
+ int tmp_3;
+ struct addrinfo *ai = malloc(sizeof(*tmp_0));
+ if (! ai) {
+ __retres = -10;
+ goto return_label;
+ }
+ struct sockaddr *sa = malloc(sizeof(*tmp_2));
+ if (! sa) {
+ __retres = -10;
+ goto return_label;
+ }
+ tmp_3 = Frama_C_interval(0,43);
+ sa->sa_family = (unsigned short)tmp_3;
+ /*@ slevel 15; */
+ {
+ int i = 0;
+ while (i < 14) {
+ {
+ int tmp_4;
+ tmp_4 = Frama_C_interval(-128,127);
+ sa->sa_data[i] = (char)tmp_4;
+ }
+ i ++;
+ }
+ }
+ /*@ slevel default; */
+ ai->ai_flags = 0;
+ ai->ai_family = (int)sa->sa_family;
+ ai->ai_socktype = Frama_C_interval(0,5);
+ ai->ai_protocol = Frama_C_interval(0,IPPROTO_MAX);
+ ai->ai_addrlen = sizeof(*sa);
+ ai->ai_addr = sa;
+ ai->ai_canonname = (char *)"dummy";
+ ai->ai_next = (struct addrinfo *)0;
+ *res = ai;
+ __retres = 0;
+ goto return_label;
+ }
+ }
+ return_label: return __retres;
+}
-/*@ assigns *stream;
- assigns *stream \from *pos; */
-extern int fsetpos(FILE *stream, fpos_t const *pos);
+struct __fc_gethostbyname __fc_ghbn;
+int res_search(char const *dname, int class, int type, char *answer,
+ int anslen)
+{
+ int tmp;
+ {
+ int i = 0;
+ while (i < anslen - 1) {
+ *(answer + i) = Frama_C_char_interval((char)(-128),(char)127);
+ i ++;
+ }
+ }
+ *(answer + (anslen - 1)) = (char)0;
+ tmp = Frama_C_interval(-1,anslen);
+ return tmp;
+}
-/*@ requires valid_stream: \valid(stream);
- ensures
- success_or_error:
- \result ≡ -1 ∨
- (\result ≥ 0 ∧ __fc_errno ≡ \old(__fc_errno));
- assigns \result, __fc_errno;
- assigns \result \from (indirect: *stream);
- assigns __fc_errno \from (indirect: *stream);
- */
-extern long ftell(FILE *stream);
+struct hostent *gethostbyname(char const *name)
+{
+ struct hostent *__retres;
+ char buf[128];
+ char const *cp;
+ int n;
+ int tmp;
+ __fc_ghbn.host.h_addrtype = 2;
+ __fc_ghbn.host.h_length = (int)sizeof(struct in_addr);
+ if ((int)*name >= '0')
+ if ((int)*name <= '9') {
+ cp = name;
+ while (1) {
+ if (! *cp) {
+ struct in_addr addr;
+ cp --;
+ ;
+ if ((int)*cp == '.') break;
+ addr.s_addr = inet_addr(name);
+ if (addr.s_addr == 0xffffffff) {
+ __retres = (struct hostent *)0;
+ goto return_label;
+ }
+ memcpy((void *)(__fc_ghbn.host_addr),(void const *)(& addr),
+ (unsigned int)__fc_ghbn.host.h_length);
+ strncpy(__fc_ghbn.hostbuf,name,(unsigned int)(128 - 1));
+ __fc_ghbn.hostbuf[128 - 1] = (char)'\000';
+ __fc_ghbn.host.h_name = __fc_ghbn.hostbuf;
+ __fc_ghbn.host.h_aliases = __fc_ghbn.host_aliases;
+ __fc_ghbn.host_aliases[0] = (char *)0;
+ __fc_ghbn.h_addr_ptrs[0] = (char *)(__fc_ghbn.host_addr);
+ __fc_ghbn.h_addr_ptrs[1] = (char *)0;
+ __fc_ghbn.host.h_addr_list = __fc_ghbn.h_addr_ptrs;
+ __retres = & __fc_ghbn.host;
+ goto return_label;
+ }
+ if ((int)*cp < '0')
+ if ((int)*cp > '9')
+ if ((int)*cp != '.') break;
+ cp ++;
+ }
+ }
+ n = res_search(name,1,1,buf,(int)sizeof(buf));
+ if (n < 0) {
+ __retres = (struct hostent *)0;
+ goto return_label;
+ }
+ tmp = Frama_C_nondet(0,1);
+ if (tmp) {
+ __retres = (struct hostent *)0;
+ goto return_label;
+ }
+ else {
+ struct in_addr addr_0;
+ addr_0.s_addr = inet_addr(name);
+ memcpy((void *)(__fc_ghbn.host_addr),(void const *)(& addr_0),
+ (unsigned int)__fc_ghbn.host.h_length);
+ strncpy(__fc_ghbn.hostbuf,name,(unsigned int)(128 - 1));
+ __fc_ghbn.hostbuf[128 - 1] = (char)'\000';
+ __fc_ghbn.host.h_name = __fc_ghbn.hostbuf;
+ __fc_ghbn.host.h_aliases = __fc_ghbn.host_aliases;
+ __fc_ghbn.host_aliases[0] = (char *)0;
+ __fc_ghbn.h_addr_ptrs[0] = (char *)(__fc_ghbn.host_addr);
+ __fc_ghbn.h_addr_ptrs[1] = (char *)0;
+ __fc_ghbn.host.h_addr_list = __fc_ghbn.h_addr_ptrs;
+ __retres = & __fc_ghbn.host;
+ goto return_label;
+ }
+ return_label: return __retres;
+}
-/*@ assigns *stream;
- assigns *stream \from \nothing; */
-extern void rewind(FILE *stream);
+FILE *__fc_stderr;
-/*@ assigns *stream;
- assigns *stream \from \nothing; */
-extern void clearerr(FILE *stream);
+FILE *__fc_stdin;
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int feof(FILE *stream);
+FILE *__fc_stdout;
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int fileno(FILE *stream);
+/*@ assigns \nothing; */
+extern int remove(char const *filename);
-/*@ assigns *stream;
- assigns *stream \from \nothing; */
-extern void flockfile(FILE *stream);
+/*@ assigns \nothing; */
+extern int rename(char const *old_name, char const *new_name);
-/*@ assigns *stream;
- assigns *stream \from \nothing; */
-extern void funlockfile(FILE *stream);
+FILE __fc_fopen[16];
+FILE * const __fc_p_fopen = __fc_fopen;
+/*@ ensures
+ result_null_or_valid_fd:
+ \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
+ assigns \result;
+ assigns \result \from __fc_p_fopen;
+ */
+extern FILE *tmpfile(void);
-/*@ assigns \result, *stream;
- assigns \result \from \nothing;
- assigns *stream \from \nothing;
+/*@ assigns \result, *(s + (..));
+ assigns \result \from *(s + (..));
+ assigns *(s + (..)) \from \nothing;
+ */
+extern char *tmpnam(char *s);
+
+/*@ requires valid_stream: \valid(stream);
+ ensures result_zero_or_EOF: \result ≡ 0 ∨ \result ≡ -1;
+ assigns \result;
+ assigns \result \from stream, stream->__fc_FILE_id;
+ */
+extern int fclose(FILE *stream);
+
+/*@ requires null_or_valid_stream: stream ≡ \null ∨ \valid_read(stream);
+ ensures result_zero_or_EOF: \result ≡ 0 ∨ \result ≡ -1;
+ assigns \result;
+ assigns \result \from stream, stream->__fc_FILE_id;
*/
-extern int ftrylockfile(FILE *stream);
+extern int fflush(FILE *stream);
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int ferror(FILE *stream);
+/*@ requires valid_filename: valid_read_string(filename);
+ requires valid_mode: valid_read_string(mode);
+ ensures
+ result_null_or_valid_fd:
+ \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
+ assigns \result;
+ assigns \result
+ \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
+ __fc_p_fopen;
+ */
+extern FILE *fopen(char const * __restrict filename,
+ char const * __restrict mode);
-/*@ assigns __fc_stdout;
- assigns __fc_stdout \from __fc_errno, *(s + (..));
+/*@ requires valid_mode: valid_read_string(mode);
+ ensures
+ result_null_or_valid_fd:
+ \result ≡ \null ∨ \subset(\result, &__fc_fopen[0 .. 16 - 1]);
+ assigns \result, __fc_fopen[fd];
+ assigns \result
+ \from (indirect: fd), (indirect: *(mode + (0 ..))),
+ (indirect: __fc_fopen[fd]), __fc_p_fopen;
+ assigns __fc_fopen[fd]
+ \from (indirect: fd), (indirect: *(mode + (0 ..))),
+ (indirect: __fc_fopen[fd]), __fc_p_fopen;
*/
-extern void perror(char const *s);
+extern FILE *fdopen(int fd, char const *mode);
-/*@ assigns \result, *stream;
- assigns \result \from *stream;
- assigns *stream \from *stream;
+/*@ requires valid_filename: valid_read_string(filename);
+ requires valid_mode: valid_read_string(mode);
+ requires valid_stream: \valid(stream);
+ ensures
+ result_null_or_valid_fd:
+ \result ≡ \null ∨ \result ∈ &__fc_fopen[0 .. 16 - 1];
+ ensures stream_opened: *\old(stream) ∈ __fc_fopen[0 .. 16 - 1];
+ assigns \result, *stream;
+ assigns \result
+ \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
+ __fc_p_fopen, (indirect: stream);
+ assigns *stream
+ \from (indirect: *(filename + (..))), (indirect: *(mode + (..))),
+ __fc_p_fopen, (indirect: stream);
*/
-extern int getc_unlocked(FILE *stream);
+extern FILE *freopen(char const * __restrict filename,
+ char const * __restrict mode, FILE * __restrict stream);
-/*@ assigns \result;
- assigns \result \from *__fc_stdin; */
-extern int getchar_unlocked(void);
+/*@ assigns *stream;
+ assigns *stream \from buf; */
+extern void setbuf(FILE * __restrict stream, char * __restrict buf);
/*@ assigns *stream;
- assigns *stream \from c; */
-extern int putc_unlocked(int c, FILE *stream);
+ assigns *stream \from buf, mode, size; */
+extern int setvbuf(FILE * __restrict stream, char * __restrict buf, int mode,
+ size_t size);
-/*@ assigns *__fc_stdout;
- assigns *__fc_stdout \from c; */
-extern int putchar_unlocked(int c);
+/*@ axiomatic format_length {
+ logic ℤ format_length{L}(char *format) ;
+
+ }
+*/
/*@ assigns *stream;
- assigns *stream \from \nothing; */
-extern void clearerr_unlocked(FILE *stream);
+ assigns *stream \from *(format + (..)), arg; */
+extern int vfprintf(FILE * __restrict stream, char const * __restrict format,
+ va_list arg);
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int feof_unlocked(FILE *stream);
+/*@ assigns *stream;
+ assigns *stream \from *(format + (..)), *stream; */
+extern int vfscanf(FILE * __restrict stream, char const * __restrict format,
+ va_list arg);
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int ferror_unlocked(FILE *stream);
+/*@ assigns *__fc_stdout;
+ assigns *__fc_stdout \from arg; */
+extern int vprintf(char const * __restrict format, va_list arg);
-/*@ assigns \result;
- assigns \result \from *stream; */
-extern int fileno_unlocked(FILE *stream);
+/*@ assigns *__fc_stdin;
+ assigns *__fc_stdin \from *(format + (..)); */
+extern int vscanf(char const * __restrict format, va_list arg);
-/*@ axiomatic pipe_streams {
- predicate is_open_pipe{L}(FILE *stream) ;
-
- }
+/*@ assigns *(s + (0 .. n - 1));
+ assigns *(s + (0 .. n - 1)) \from *(format + (..)), arg;
+ */
+extern int vsnprintf(char * __restrict s, size_t n,
+ char const * __restrict format, va_list arg);
-*/
-/*@ requires valid_command: valid_read_string(command);
- requires valid_type: valid_read_string(type);
- ensures
- result_error_or_valid_open_pipe:
- \result ≡ \null ∨
- (\subset(\result, &__fc_fopen[0 .. 16 - 1]) ∧ is_open_pipe(\result));
- assigns \result, __fc_fopen[0 ..];
- assigns \result
- \from (indirect: *command), (indirect: *type), __fc_p_fopen;
- assigns __fc_fopen[0 ..]
- \from (indirect: *command), (indirect: *type), __fc_fopen[0 ..];
+/*@ assigns *(s + (0 ..));
+ assigns *(s + (0 ..)) \from *(format + (..)), arg;
*/
-extern FILE *popen(char const *command, char const *type);
+extern int vsprintf(char * __restrict s, char const * __restrict format,
+ va_list arg);
/*@ requires valid_stream: \valid(stream);
- requires open_pipe: is_open_pipe(stream);
- ensures closed_stream: ¬is_open_pipe(\old(stream));
- assigns \result;
+ ensures result_uchar_or_eof: (0 ≤ \result ≤ 255) ∨ \result ≡ -1;
+ assigns *stream, \result;
+ assigns *stream \from *stream;
assigns \result \from (indirect: *stream);
*/
-extern int pclose(FILE *stream);
-
-ssize_t getline(char **lineptr, size_t *n, FILE *stream);
-
-FILE __fc_initial_stdout =
- {.__fc_FILE_id = (unsigned int)1, .__fc_FILE_data = 0U};
-FILE *__fc_stdout = & __fc_initial_stdout;
-FILE __fc_initial_stderr =
- {.__fc_FILE_id = (unsigned int)2, .__fc_FILE_data = 0U};
-FILE *__fc_stderr = & __fc_initial_stderr;
-FILE __fc_initial_stdin =
- {.__fc_FILE_id = (unsigned int)0, .__fc_FILE_data = 0U};
-FILE *__fc_stdin = & __fc_initial_stdin;
-ssize_t getline(char **lineptr, size_t *n, FILE *stream)
-{
- ssize_t __retres;
- int tmp;
- if (! lineptr) goto _LOR;
- else
- if (! n) goto _LOR;
- else
- if (! stream) {
- _LOR: {
- __fc_errno = 22;
- __retres = -1;
- goto return_label;
- }
- }
- tmp = ferror(stream);
- if (tmp) goto _LOR_0;
- else {
- int tmp_0;
- tmp_0 = feof(stream);
- if (tmp_0) {
- _LOR_0: {
- __retres = -1;
- goto return_label;
- }
- }
- }
- if (! *lineptr) goto _LOR_1;
- else
- if (*n == (size_t)0) {
- _LOR_1:
- {
- *lineptr = (char *)malloc((unsigned int)2);
- if (! lineptr) {
- __fc_errno = 12;
- __retres = -1;
- goto return_label;
- }
- *n = (unsigned int)2;
- }
- }
- size_t cur = (unsigned int)0;
- while (1) {
- int tmp_3;
- tmp_3 = ferror(stream);
- if (tmp_3) break;
- else {
- int tmp_4;
- tmp_4 = feof(stream);
- if (tmp_4) break;
- }
- {
- while (cur < *n - (size_t)1) {
- int tmp_1;
- tmp_1 = fgetc(stream);
- char c = (char)tmp_1;
- if ((int)c == -1)
- if (cur == (size_t)0) {
- __retres = -1;
- goto return_label;
- }
- if ((int)c != -1) {
- size_t tmp_2;
- tmp_2 = cur;
- cur += (size_t)1;
- *(*lineptr + tmp_2) = c;
- }
- if ((int)c == '\n') goto _LOR_2;
- else
- if ((int)c == -1) {
- _LOR_2:
- {
- *(*lineptr + cur) = (char)'\000';
- __retres = (int)cur;
- goto return_label;
- }
- }
- }
- if (*n == (size_t)2147483647) {
- __fc_errno = 75;
- __retres = -1;
- goto return_label;
- }
- size_t new_size = *n + (size_t)1;
- *lineptr = (char *)realloc((void *)*lineptr,new_size);
- if (! *lineptr) {
- __fc_errno = 12;
- __retres = -1;
- goto return_label;
- }
- *n = new_size;
- }
- }
- __retres = -1;
- return_label: return __retres;
-}
+extern int fgetc(FILE *stream);
-/*@
-predicate non_escaping{L}(void *s, size_t n) =
- ∀ unsigned int i; 0 ≤ i < n ⇒ ¬\dangling((char *)s + i);
- */
-/*@
-predicate empty_block{L}(void *s) =
- \block_length((char *)s) ≡ 0 ∧ \offset((char *)s) ≡ 0;
- */
-/*@
-predicate valid_or_empty{L}(void *s, size_t n) =
- (empty_block(s) ∨ \valid_read((char *)s)) ∧
- \valid((char *)s + (0 .. n - 1));
+/*@ requires valid_stream: \valid(stream);
+ ensures result_null_or_same: \result ≡ \null ∨ \result ≡ \old(s);
+ ensures
+ terminated_string_on_success:
+ \result ≢ \null ⇒ valid_string(\old(s));
+ assigns *(s + (0 .. size)), \result;
+ assigns *(s + (0 .. size)) \from (indirect: size), (indirect: *stream);
+ assigns \result \from s, (indirect: size), (indirect: *stream);
*/
-/*@
-predicate valid_read_or_empty{L}(void *s, size_t n) =
- (empty_block(s) ∨ \valid_read((char *)s)) ∧
- \valid_read((char *)s + (1 .. n - 1));
+extern char *fgets(char * __restrict s, int size, FILE * __restrict stream);
-*/
-int memcmp(void const *s1, void const *s2, size_t n);
+/*@ assigns *stream; */
+extern int fputc(int c, FILE *stream);
-void *memchr(void const *s, int c, size_t n);
+/*@ assigns *stream;
+ assigns *stream \from *(s + (..)); */
+extern int fputs(char const * __restrict s, FILE * __restrict stream);
-void *memcpy(void * __restrict dest, void const * __restrict src, size_t n);
+/*@ assigns \result, *stream;
+ assigns \result \from *stream;
+ assigns *stream \from *stream;
+ */
+extern int getc(FILE *stream);
-void *memmove(void *dest, void const *src, size_t n);
+/*@ assigns \result;
+ assigns \result \from *__fc_stdin; */
+extern int getchar(void);
-void *memset(void *s, int c, size_t n);
+/*@ ensures result_null_or_same: \result ≡ \old(s) ∨ \result ≡ \null;
+ assigns *(s + (..)), \result;
+ assigns *(s + (..)) \from *__fc_stdin;
+ assigns \result \from s, __fc_stdin;
+ */
+extern char *gets(char *s);
-size_t strlen(char const *s);
+/*@ assigns *stream;
+ assigns *stream \from c; */
+extern int putc(int c, FILE *stream);
-size_t strnlen(char const *s, size_t maxlen);
+/*@ assigns *__fc_stdout;
+ assigns *__fc_stdout \from c; */
+extern int putchar(int c);
-int strcmp(char const *s1, char const *s2);
+/*@ assigns *__fc_stdout;
+ assigns *__fc_stdout \from *(s + (..)); */
+extern int puts(char const *s);
-int strncmp(char const *s1, char const *s2, size_t n);
+/*@ assigns *stream;
+ assigns *stream \from c; */
+extern int ungetc(int c, FILE *stream);
-/*@ requires valid_string_s1: valid_read_string(s1);
- requires valid_string_s2: valid_read_string(s2);
- assigns \result;
- assigns \result
- \from (indirect: *(s1 + (0 ..))), (indirect: *(s2 + (0 ..)));
+/*@ requires valid_ptr_block: \valid((char *)ptr + (0 .. nmemb * size - 1));
+ requires valid_stream: \valid(stream);
+ ensures size_read: \result ≤ \old(nmemb);
+ ensures
+ initialization:
+ \initialized((char *)\old(ptr) + (0 .. \result * \old(size) - 1));
+ assigns *((char *)ptr + (0 .. nmemb * size - 1)), \result;
+ assigns *((char *)ptr + (0 .. nmemb * size - 1))
+ \from size, nmemb, *stream;
+ assigns \result \from size, *stream;
*/
-extern int strcoll(char const *s1, char const *s2);
+extern size_t fread(void * __restrict ptr, size_t size, size_t nmemb,
+ FILE * __restrict stream);
-char *strchr(char const *s, int c);
+/*@ requires
+ valid_ptr_block: \valid_read((char *)ptr + (0 .. nmemb * size - 1));
+ requires valid_stream: \valid(stream);
+ ensures size_written: \result ≤ \old(nmemb);
+ assigns *stream, \result;
+ assigns *stream \from *((char *)ptr + (0 .. nmemb * size - 1));
+ assigns \result \from *((char *)ptr + (0 .. nmemb * size - 1));
+ */
+extern size_t fwrite(void const * __restrict ptr, size_t size, size_t nmemb,
+ FILE * __restrict stream);
-char *strrchr(char const *s, int c);
+/*@ assigns *pos;
+ assigns *pos \from *stream; */
+extern int fgetpos(FILE * __restrict stream, fpos_t * __restrict pos);
-/*@ requires valid_string_s: valid_read_string(s);
- requires valid_string_reject: valid_read_string(reject);
- ensures result_bounded: 0 ≤ \result ≤ strlen(\old(s));
- assigns \result;
+/*@ requires valid_stream: \valid(stream);
+ requires whence_enum: whence ≡ 0 ∨ whence ≡ 1 ∨ whence ≡ 2;
+ assigns *stream, \result, __fc_errno;
+ assigns *stream \from *stream, (indirect: offset), (indirect: whence);
assigns \result
- \from (indirect: *(s + (0 ..))), (indirect: *(reject + (0 ..)));
+ \from (indirect: *stream), (indirect: offset), (indirect: whence);
+ assigns __fc_errno
+ \from (indirect: *stream), (indirect: offset), (indirect: whence);
*/
-extern size_t strcspn(char const *s, char const *reject);
+extern int fseek(FILE *stream, long offset, int whence);
-/*@ requires valid_string_s: valid_read_string(s);
- requires valid_string_accept: valid_read_string(accept);
- ensures result_bounded: 0 ≤ \result ≤ strlen(\old(s));
- assigns \result, \result;
- assigns \result \from *(s + (0 ..)), *(accept + (0 ..));
- assigns \result
- \from (indirect: *(s + (0 ..))), (indirect: *(accept + (0 ..)));
- */
-extern size_t strspn(char const *s, char const *accept);
+/*@ assigns *stream;
+ assigns *stream \from *pos; */
+extern int fsetpos(FILE *stream, fpos_t const *pos);
-/*@ requires valid_string_s: valid_read_string(s);
- requires valid_string_accept: valid_read_string(accept);
+/*@ requires valid_stream: \valid(stream);
ensures
- result_null_or_same_base:
- \result ≡ \null ∨ \base_addr(\result) ≡ \base_addr(\old(s));
- assigns \result;
- assigns \result \from s, *(s + (0 ..)), *(accept + (0 ..));
+ success_or_error:
+ \result ≡ -1 ∨
+ (\result ≥ 0 ∧ __fc_errno ≡ \old(__fc_errno));
+ assigns \result, __fc_errno;
+ assigns \result \from (indirect: *stream);
+ assigns __fc_errno \from (indirect: *stream);
*/
-extern char *strpbrk(char const *s, char const *accept);
+extern long ftell(FILE *stream);
-char *strstr(char const *haystack, char const *needle);
+/*@ assigns *stream;
+ assigns *stream \from \nothing; */
+extern void rewind(FILE *stream);
-char *__fc_strtok_ptr;
-/*@ requires valid_string_delim: valid_read_string(delim);
- assigns *(s + (0 ..)), *(__fc_strtok_ptr + (0 ..)), \result,
- __fc_strtok_ptr;
- assigns *(s + (0 ..))
- \from *(s + (0 ..)), (indirect: s), (indirect: __fc_strtok_ptr),
- (indirect: *(delim + (0 ..)));
- assigns *(__fc_strtok_ptr + (0 ..))
- \from *(__fc_strtok_ptr + (0 ..)), (indirect: s),
- (indirect: __fc_strtok_ptr), (indirect: *(delim + (0 ..)));
- assigns \result
- \from s, __fc_strtok_ptr, (indirect: *(s + (0 ..))),
- (indirect: *(__fc_strtok_ptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
- assigns __fc_strtok_ptr
- \from \old(__fc_strtok_ptr), s,
- (indirect: *(__fc_strtok_ptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
-
- behavior new_str:
- assumes s_not_null: s ≢ \null;
- requires
- valid_string_s_or_delim_not_found:
- valid_string(s) ∨
- (valid_read_string(s) ∧
- (∀ int i;
- 0 ≤ i < strlen(delim) ⇒
- ¬(strchr(s, *(delim + i)) ≡ \true)));
- ensures
- result_subset:
- \result ≡ \null ∨ \subset(\result, \old(s) + (0 ..));
- ensures ptr_subset: \subset(__fc_strtok_ptr, \old(s) + (0 ..));
- assigns __fc_strtok_ptr, *(s + (0 ..)), \result;
- assigns __fc_strtok_ptr
- \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
- assigns *(s + (0 ..))
- \from *(s + (0 ..)), (indirect: s), (indirect: *(delim + (0 ..)));
- assigns \result
- \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
-
- behavior resume_str:
- assumes s_null: s ≡ \null;
- requires not_first_call: __fc_strtok_ptr ≢ \null;
- ensures
- result_subset:
- \result ≡ \null ∨
- \subset(\result, \old(__fc_strtok_ptr) + (0 ..));
- ensures
- ptr_subset: \subset(__fc_strtok_ptr, \old(__fc_strtok_ptr) + (0 ..));
- assigns *(__fc_strtok_ptr + (0 ..)), __fc_strtok_ptr, \result;
- assigns *(__fc_strtok_ptr + (0 ..))
- \from *(__fc_strtok_ptr + (0 ..)), (indirect: __fc_strtok_ptr),
- (indirect: *(delim + (0 ..)));
- assigns __fc_strtok_ptr
- \from \old(__fc_strtok_ptr), (indirect: *(__fc_strtok_ptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
- assigns \result
- \from __fc_strtok_ptr, (indirect: *(__fc_strtok_ptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
-
- complete behaviors resume_str, new_str;
- disjoint behaviors resume_str, new_str;
- */
-extern char *strtok(char * __restrict s, char const * __restrict delim);
+/*@ assigns *stream;
+ assigns *stream \from \nothing; */
+extern void clearerr(FILE *stream);
-/*@ requires valid_string_delim: valid_read_string(delim);
- requires valid_saveptr: \valid(saveptr);
- assigns *(s + (0 ..)), *(*saveptr + (0 ..)), \result, *saveptr;
- assigns *(s + (0 ..))
- \from *(s + (0 ..)), (indirect: s), (indirect: *saveptr),
- (indirect: *(delim + (0 ..)));
- assigns *(*saveptr + (0 ..))
- \from *(*saveptr + (0 ..)), (indirect: s), (indirect: *saveptr),
- (indirect: *(delim + (0 ..)));
- assigns \result
- \from s, *saveptr, (indirect: *(s + (0 ..))),
- (indirect: *(*saveptr + (0 ..))), (indirect: *(delim + (0 ..)));
- assigns *saveptr
- \from \old(*saveptr), s, (indirect: *(*saveptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
-
- behavior new_str:
- assumes s_not_null: s ≢ \null;
- requires
- valid_string_s_or_delim_not_found:
- valid_string(s) ∨
- (valid_read_string(s) ∧
- (∀ int i;
- 0 ≤ i < strlen(delim) ⇒
- ¬(strchr(s, *(delim + i)) ≡ \true)));
- ensures
- result_subset:
- \result ≡ \null ∨ \subset(\result, \old(s) + (0 ..));
- ensures initialization: \initialized(\old(saveptr));
- ensures saveptr_subset: \subset(*\old(saveptr), \old(s) + (0 ..));
- assigns *saveptr, *(s + (0 ..)), \result;
- assigns *saveptr
- \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
- assigns *(s + (0 ..))
- \from *(s + (0 ..)), (indirect: s), (indirect: *(delim + (0 ..)));
- assigns \result
- \from s, (indirect: *(s + (0 ..))), (indirect: *(delim + (0 ..)));
-
- behavior resume_str:
- assumes s_null: s ≡ \null;
- requires not_first_call: *saveptr ≢ \null;
- requires initialization: saveptr: \initialized(saveptr);
- ensures
- result_subset:
- \result ≡ \null ∨ \subset(\result, \old(*saveptr) + (0 ..));
- ensures
- saveptr_subset: \subset(*\old(saveptr), \old(*saveptr) + (0 ..));
- assigns *(*saveptr + (0 ..)), *saveptr, \result;
- assigns *(*saveptr + (0 ..))
- \from *(*saveptr + (0 ..)), (indirect: *saveptr),
- (indirect: *(delim + (0 ..)));
- assigns *saveptr
- \from \old(*saveptr), (indirect: *(*saveptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
- assigns \result
- \from *saveptr, (indirect: *(*saveptr + (0 ..))),
- (indirect: *(delim + (0 ..)));
-
- complete behaviors resume_str, new_str;
- disjoint behaviors resume_str, new_str;
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int feof(FILE *stream);
+
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int fileno(FILE *stream);
+
+/*@ assigns *stream;
+ assigns *stream \from \nothing; */
+extern void flockfile(FILE *stream);
+
+/*@ assigns *stream;
+ assigns *stream \from \nothing; */
+extern void funlockfile(FILE *stream);
+
+/*@ assigns \result, *stream;
+ assigns \result \from \nothing;
+ assigns *stream \from \nothing;
*/
-extern char *strtok_r(char * __restrict s, char const * __restrict delim,
- char ** __restrict saveptr);
+extern int ftrylockfile(FILE *stream);
-/*@ requires
- valid_string_stringp: \valid(stringp) ∧ valid_string(*stringp);
- requires valid_string_delim: valid_read_string(delim);
- assigns *stringp, \result;
- assigns *stringp \from *(delim + (..)), *(*(stringp + (..)));
- assigns \result \from *(delim + (..)), *(*(stringp + (..)));
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int ferror(FILE *stream);
+
+/*@ assigns __fc_stdout;
+ assigns __fc_stdout \from __fc_errno, *(s + (..));
*/
-extern char *strsep(char **stringp, char const *delim);
+extern void perror(char const *s);
-extern char __fc_strerror[64];
+/*@ assigns \result, *stream;
+ assigns \result \from *stream;
+ assigns *stream \from *stream;
+ */
+extern int getc_unlocked(FILE *stream);
-char * const __fc_p_strerror = __fc_strerror;
-char *strerror(int errnum);
+/*@ assigns \result;
+ assigns \result \from *__fc_stdin; */
+extern int getchar_unlocked(void);
-char *strcpy(char *dest, char const *src);
+/*@ assigns *stream;
+ assigns *stream \from c; */
+extern int putc_unlocked(int c, FILE *stream);
-char *strncpy(char *dest, char const *src, size_t n);
+/*@ assigns *__fc_stdout;
+ assigns *__fc_stdout \from c; */
+extern int putchar_unlocked(int c);
-char *strcat(char *dest, char const *src);
+/*@ assigns *stream;
+ assigns *stream \from \nothing; */
+extern void clearerr_unlocked(FILE *stream);
-char *strncat(char *dest, char const *src, size_t n);
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int feof_unlocked(FILE *stream);
-/*@ requires valid_dest: \valid(dest + (0 .. n - 1));
- requires valid_string_src: valid_read_string(src);
- assigns *(dest + (0 .. n - 1)), \result;
- assigns *(dest + (0 .. n - 1))
- \from (indirect: *(src + (0 ..))), (indirect: n);
- assigns \result \from dest;
- */
-extern size_t strxfrm(char * __restrict dest, char const * __restrict src,
- size_t n);
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int ferror_unlocked(FILE *stream);
-char *strdup(char const *s);
+/*@ assigns \result;
+ assigns \result \from *stream; */
+extern int fileno_unlocked(FILE *stream);
-char *strndup(char const *s, size_t n);
+/*@ axiomatic pipe_streams {
+ predicate is_open_pipe{L}(FILE *stream) ;
+
+ }
-/*@ requires valid_memory_area: \valid((char *)s + (0 .. n - 1));
+*/
+/*@ requires valid_command: valid_read_string(command);
+ requires valid_type: valid_read_string(type);
ensures
- zero_initialized: \subset(*((char *)\old(s) + (0 .. \old(n) - 1)), {0});
- assigns *((char *)s + (0 .. n - 1));
- assigns *((char *)s + (0 .. n - 1)) \from \nothing;
+ result_error_or_valid_open_pipe:
+ \result ≡ \null ∨
+ (\subset(\result, &__fc_fopen[0 .. 16 - 1]) ∧ is_open_pipe(\result));
+ assigns \result, __fc_fopen[0 ..];
+ assigns \result
+ \from (indirect: *command), (indirect: *type), __fc_p_fopen;
+ assigns __fc_fopen[0 ..]
+ \from (indirect: *command), (indirect: *type), __fc_fopen[0 ..];
*/
-extern void bzero(void *s, size_t n);
-
-int strcasecmp(char const *s1, char const *s2);
+extern FILE *popen(char const *command, char const *type);
-/*@ requires valid_string_s1: valid_read_nstring(s1, n);
- requires valid_string_s2: valid_read_nstring(s2, n);
+/*@ requires valid_stream: \valid(stream);
+ requires open_pipe: is_open_pipe(stream);
+ ensures closed_stream: ¬is_open_pipe(\old(stream));
assigns \result;
- assigns \result
- \from (indirect: n), (indirect: *(s1 + (0 .. n - 1))),
- (indirect: *(s2 + (0 .. n - 1)));
+ assigns \result \from (indirect: *stream);
*/
-extern int strncasecmp(char const *s1, char const *s2, size_t n);
+extern int pclose(FILE *stream);
+
+ssize_t getline(char **lineptr, size_t *n, FILE *stream);
+
+FILE __fc_initial_stdout =
+ {.__fc_FILE_id = (unsigned int)1, .__fc_FILE_data = 0U};
+FILE *__fc_stdout = & __fc_initial_stdout;
+FILE __fc_initial_stderr =
+ {.__fc_FILE_id = (unsigned int)2, .__fc_FILE_data = 0U};
+FILE *__fc_stderr = & __fc_initial_stderr;
+FILE __fc_initial_stdin =
+ {.__fc_FILE_id = (unsigned int)0, .__fc_FILE_data = 0U};
+FILE *__fc_stdin = & __fc_initial_stdin;
+ssize_t getline(char **lineptr, size_t *n, FILE *stream)
+{
+ ssize_t __retres;
+ int tmp;
+ if (! lineptr) goto _LOR;
+ else
+ if (! n) goto _LOR;
+ else
+ if (! stream) {
+ _LOR: {
+ __fc_errno = 22;
+ __retres = -1;
+ goto return_label;
+ }
+ }
+ tmp = ferror(stream);
+ if (tmp) goto _LOR_0;
+ else {
+ int tmp_0;
+ tmp_0 = feof(stream);
+ if (tmp_0) {
+ _LOR_0: {
+ __retres = -1;
+ goto return_label;
+ }
+ }
+ }
+ if (! *lineptr) goto _LOR_1;
+ else
+ if (*n == (size_t)0) {
+ _LOR_1:
+ {
+ *lineptr = (char *)malloc((unsigned int)2);
+ if (! lineptr) {
+ __fc_errno = 12;
+ __retres = -1;
+ goto return_label;
+ }
+ *n = (unsigned int)2;
+ }
+ }
+ size_t cur = (unsigned int)0;
+ while (1) {
+ int tmp_3;
+ tmp_3 = ferror(stream);
+ if (tmp_3) break;
+ else {
+ int tmp_4;
+ tmp_4 = feof(stream);
+ if (tmp_4) break;
+ }
+ {
+ while (cur < *n - (size_t)1) {
+ int tmp_1;
+ tmp_1 = fgetc(stream);
+ char c = (char)tmp_1;
+ if ((int)c == -1)
+ if (cur == (size_t)0) {
+ __retres = -1;
+ goto return_label;
+ }
+ if ((int)c != -1) {
+ size_t tmp_2;
+ tmp_2 = cur;
+ cur += (size_t)1;
+ *(*lineptr + tmp_2) = c;
+ }
+ if ((int)c == '\n') goto _LOR_2;
+ else
+ if ((int)c == -1) {
+ _LOR_2:
+ {
+ *(*lineptr + cur) = (char)'\000';
+ __retres = (int)cur;
+ goto return_label;
+ }
+ }
+ }
+ if (*n == (size_t)2147483647) {
+ __fc_errno = 75;
+ __retres = -1;
+ goto return_label;
+ }
+ size_t new_size = *n + (size_t)1;
+ *lineptr = (char *)realloc((void *)*lineptr,new_size);
+ if (! *lineptr) {
+ __fc_errno = 12;
+ __retres = -1;
+ goto return_label;
+ }
+ *n = new_size;
+ }
+ }
+ __retres = -1;
+ return_label: return __retres;
+}
/*@ requires abs_representable: i > -2147483647 - 1;
assigns \result;
@@ -4343,6 +4452,59 @@ int unsetenv(char const *name)
return_label: return __retres;
}
+/*@ requires valid_memptr: \valid(memptr);
+ requires
+ alignment_is_a_suitable_power_of_two:
+ alignment ≥ sizeof(void *) ∧
+ ((unsigned int)alignment & ((unsigned int)alignment - 1)) ≡ 0;
+ assigns __fc_heap_status, \result;
+ assigns __fc_heap_status
+ \from (indirect: alignment), size, __fc_heap_status;
+ assigns \result
+ \from (indirect: alignment), (indirect: size),
+ (indirect: __fc_heap_status);
+ allocates *\old(memptr);
+
+ behavior allocation:
+ assumes can_allocate: is_allocable(size);
+ ensures allocation: \fresh{Old, Here}(*\old(memptr),\old(size));
+ ensures result_zero: \result ≡ 0;
+ assigns __fc_heap_status, \result;
+ assigns __fc_heap_status
+ \from (indirect: alignment), size, __fc_heap_status;
+ assigns \result
+ \from (indirect: alignment), (indirect: size),
+ (indirect: __fc_heap_status);
+
+ behavior no_allocation:
+ assumes cannot_allocate: ¬is_allocable(size);
+ ensures result_non_zero: \result < 0 ∨ \result > 0;
+ assigns \result;
+ assigns \result \from (indirect: alignment);
+ allocates \nothing;
+
+ complete behaviors no_allocation, allocation;
+ disjoint behaviors no_allocation, allocation;
+ */
+int posix_memalign(void **memptr, size_t alignment, size_t size)
+{
+ int __retres;
+ /*@
+ assert
+ alignment_is_a_suitable_power_of_two:
+ alignment ≥ sizeof(void *) ∧
+ ((unsigned int)alignment & ((unsigned int)alignment - 1)) ≡ 0;
+ */
+ ;
+ *memptr = malloc(size);
+ if (! *memptr) {
+ __retres = 12;
+ goto return_label;
+ }
+ __retres = 0;
+ return_label: return __retres;
+}
+
/*@ requires valid_dest: valid_or_empty(dest, n);
requires valid_src: valid_read_or_empty(src, n);
requires
@@ -5163,7 +5325,7 @@ extern time_t mktime(struct tm *timeptr);
extern time_t time(time_t *timer);
char __fc_ctime[26];
-char * const __fc_p_ctime = (char *)(& __fc_ctime);
+char * const __fc_p_ctime = __fc_ctime;
/*@ requires valid_timer: \valid_read(timer);
requires initialization: init_timer: \initialized(timer);
ensures result_points_to_ctime: \result ≡ __fc_p_ctime;
@@ -6424,6 +6586,36 @@ extern int iconv_close(iconv_t);
*/
extern iconv_t iconv_open(char const *tocode, char const *fromcode);
+extern char __fc_basename[256];
+
+char *__fc_p_basename = __fc_basename;
+/*@ requires
+ null_or_valid_string_path: path ≡ \null ∨ valid_read_string(path);
+ ensures
+ result_points_to_internal_storage_or_path:
+ \subset(\result, \union(__fc_p_basename, \old(path)));
+ assigns *(path + (0 ..)), __fc_basename[0 ..], \result;
+ assigns *(path + (0 ..)) \from *(path + (0 ..)), __fc_basename[0 ..];
+ assigns __fc_basename[0 ..] \from *(path + (0 ..)), __fc_basename[0 ..];
+ assigns \result \from __fc_p_basename, path;
+ */
+extern char *basename(char *path);
+
+extern char __fc_dirname[256];
+
+char *__fc_p_dirname = __fc_dirname;
+/*@ requires
+ null_or_valid_string_path: path ≡ \null ∨ valid_read_string(path);
+ ensures
+ result_points_to_internal_storage_or_path:
+ \subset(\result, \union(__fc_p_dirname, \old(path)));
+ assigns *(path + (0 ..)), __fc_dirname[0 ..], \result;
+ assigns *(path + (0 ..)) \from *(path + (0 ..)), __fc_dirname[0 ..];
+ assigns __fc_dirname[0 ..] \from *(path + (0 ..)), __fc_dirname[0 ..];
+ assigns \result \from __fc_p_dirname, path;
+ */
+extern char *dirname(char *path);
+
/*@ requires valid_file_descriptors: \valid(fds + (0 .. nfds - 1));
ensures
error_timeout_or_bounded:
diff --git a/tests/libc/oracle/fc_libc.2.res.oracle b/tests/libc/oracle/fc_libc.2.res.oracle
index 6b9a23013e847f252018dedf4ae23366c1661de7..6650a34b1f8c6d193393997a674224079b26f14a 100644
--- a/tests/libc/oracle/fc_libc.2.res.oracle
+++ b/tests/libc/oracle/fc_libc.2.res.oracle
@@ -63,13 +63,7 @@ skipping share/libc/complex.h
[kernel] Parsing share/libc/inttypes.h (with preprocessing)
[kernel] Parsing share/libc/iso646.h (with preprocessing)
[kernel] Parsing share/libc/libgen.h (with preprocessing)
-[kernel] Parsing share/libc/libintl.h (with preprocessing)
[kernel] Parsing share/libc/limits.h (with preprocessing)
-[kernel] Parsing share/libc/linux/fs.h (with preprocessing)
-[kernel] Parsing share/libc/linux/if_addr.h (with preprocessing)
-[kernel] Parsing share/libc/linux/if_netlink.h (with preprocessing)
-[kernel] Parsing share/libc/linux/netlink.h (with preprocessing)
-[kernel] Parsing share/libc/linux/rtnetlink.h (with preprocessing)
[kernel] Parsing share/libc/locale.h (with preprocessing)
[kernel] Parsing share/libc/malloc.h (with preprocessing)
[kernel] Parsing share/libc/math.h (with preprocessing)
@@ -77,9 +71,6 @@ skipping share/libc/complex.h
[kernel] Parsing share/libc/net/if.h (with preprocessing)
[kernel] Parsing share/libc/netdb.h (with preprocessing)
[kernel] Parsing share/libc/netinet/in.h (with preprocessing)
-[kernel] Parsing share/libc/netinet/in_systm.h (with preprocessing)
-[kernel] Parsing share/libc/netinet/ip.h (with preprocessing)
-[kernel] Parsing share/libc/netinet/ip_icmp.h (with preprocessing)
[kernel] Parsing share/libc/netinet/tcp.h (with preprocessing)
[kernel] Parsing share/libc/nl_types.h (with preprocessing)
[kernel] Parsing share/libc/poll.h (with preprocessing)
@@ -104,7 +95,6 @@ skipping share/libc/complex.h
[kernel] Parsing share/libc/sys/ioctl.h (with preprocessing)
[kernel] Parsing share/libc/sys/ipc.h (with preprocessing)
[kernel] Parsing share/libc/sys/mman.h (with preprocessing)
-[kernel] Parsing share/libc/sys/param.h (with preprocessing)
[kernel] Parsing share/libc/sys/random.h (with preprocessing)
[kernel] Parsing share/libc/sys/resource.h (with preprocessing)
[kernel] Parsing share/libc/sys/select.h (with preprocessing)
@@ -112,7 +102,6 @@ skipping share/libc/complex.h
[kernel] Parsing share/libc/sys/signal.h (with preprocessing)
[kernel] Parsing share/libc/sys/socket.h (with preprocessing)
[kernel] Parsing share/libc/sys/stat.h (with preprocessing)
-[kernel] Parsing share/libc/sys/sysctl.h (with preprocessing)
[kernel] Parsing share/libc/sys/time.h (with preprocessing)
[kernel] Parsing share/libc/sys/times.h (with preprocessing)
[kernel] Parsing share/libc/sys/timex.h (with preprocessing)
@@ -125,7 +114,6 @@ skipping share/libc/complex.h
[kernel] Parsing share/libc/termios.h (with preprocessing)
skipping share/libc/tgmath.h
[kernel] Parsing share/libc/time.h (with preprocessing)
-[kernel] Parsing share/libc/uchar.h (with preprocessing)
[kernel] Parsing share/libc/unistd.h (with preprocessing)
[kernel] Parsing share/libc/utime.h (with preprocessing)
[kernel] Parsing share/libc/utmpx.h (with preprocessing)
diff --git a/tests/libc/oracle/libgen_h.res.oracle b/tests/libc/oracle/libgen_h.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..ca158666adf08acb2890a53b2ae8fecfddb3e132
--- /dev/null
+++ b/tests/libc/oracle/libgen_h.res.oracle
@@ -0,0 +1,48 @@
+[kernel] Parsing tests/libc/libgen_h.c (with 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] computing for function basename <- main.
+ Called from tests/libc/libgen_h.c:9.
+[eva] using specification for function basename
+[eva] tests/libc/libgen_h.c:9:
+ function basename: precondition 'null_or_valid_string_path' got status valid.
+[eva] Done for function basename
+[eva:alarm] tests/libc/libgen_h.c:10: Warning: assertion got status unknown.
+[eva] computing for function basename <- main.
+ Called from tests/libc/libgen_h.c:11.
+[eva] tests/libc/libgen_h.c:11:
+ function basename: precondition 'null_or_valid_string_path' got status valid.
+[eva] tests/libc/libgen_h.c:11: Warning:
+ Completely invalid destination for assigns clause *(path + (0 ..)). Ignoring.
+[eva] Done for function basename
+[eva:alarm] tests/libc/libgen_h.c:12: Warning: assertion got status unknown.
+[eva] computing for function dirname <- main.
+ Called from tests/libc/libgen_h.c:14.
+[eva] using specification for function dirname
+[eva:alarm] tests/libc/libgen_h.c:14: Warning:
+ function dirname: precondition 'null_or_valid_string_path' got status unknown.
+[eva] Done for function dirname
+[eva:alarm] tests/libc/libgen_h.c:15: Warning: assertion got status unknown.
+[eva] computing for function dirname <- main.
+ Called from tests/libc/libgen_h.c:16.
+[eva] tests/libc/libgen_h.c:16:
+ function dirname: precondition 'null_or_valid_string_path' got status valid.
+[eva] tests/libc/libgen_h.c:16: Warning:
+ Completely invalid destination for assigns clause *(path + (0 ..)). Ignoring.
+[eva] Done for function dirname
+[eva:alarm] tests/libc/libgen_h.c:17: Warning: assertion got status unknown.
+[eva] Recording results for main
+[eva] done for function main
+[eva] ====== VALUES COMPUTED ======
+[eva:final-states] Values at end of function main:
+ __fc_basename[0..255] ∈ [--..--]
+ __fc_dirname[0..255] ∈ [--..--]
+ path[0..127] ∈ [--..--]
+ base ∈ {{ &__fc_basename[0] ; &path[0] }}
+ base2 ∈ {{ NULL ; &__fc_basename[0] }}
+ dir ∈ {{ &__fc_dirname[0] ; &path[0] }}
+ dir2 ∈ {{ NULL ; &__fc_dirname[0] }}
+ __retres ∈ {0}
diff --git a/tests/libc/oracle/netdb_c.res.oracle b/tests/libc/oracle/netdb_c.res.oracle
index b8c3b75e0ae244c71120466dc56dd0e42bda4a7e..d928b74c99c4288108e90321e18e9267c38640e8 100644
--- a/tests/libc/oracle/netdb_c.res.oracle
+++ b/tests/libc/oracle/netdb_c.res.oracle
@@ -35,10 +35,13 @@
\return(bind) == 0 (auto)
\return(socket) == -1 (auto)
\return(signal) == 0 (auto)
+ \return(inet_addr) == 4294967295 (auto)
\return(inet_ntoa) == 0 (auto)
\return(inet_ntop) == 0 (auto)
\return(gai_strerror) == 0 (auto)
\return(getaddrinfo) == 0 (auto)
+ \return(gethostbyname) == 0 (auto)
+ \return(Frama_C_nondet) == 0 (auto)
\return(Frama_C_nondet_ptr) == 0 (auto)
[eva] Analyzing a complete application starting at main
[eva] Computing initial state
@@ -52,68 +55,68 @@
cannot evaluate ACSL term, unsupported ACSL construct: logic function memset
[eva] computing for function getaddrinfo <- main.
Called from tests/libc/netdb_c.c:42.
-[eva] share/libc/netdb.c:55: Call to builtin malloc
-[eva] share/libc/netdb.c:55: allocating variable __malloc_getaddrinfo_l55
-[eva] share/libc/netdb.c:57: Call to builtin malloc
-[eva] share/libc/netdb.c:57: allocating variable __malloc_getaddrinfo_l57
+[eva] share/libc/netdb.c:56: Call to builtin malloc
+[eva] share/libc/netdb.c:56: allocating variable __malloc_getaddrinfo_l56
+[eva] share/libc/netdb.c:58: Call to builtin malloc
+[eva] share/libc/netdb.c:58: allocating variable __malloc_getaddrinfo_l58
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:59.
+ Called from share/libc/netdb.c:60.
[eva] using specification for function Frama_C_interval
-[eva] share/libc/netdb.c:59:
+[eva] share/libc/netdb.c:60:
function Frama_C_interval: precondition 'order' got status valid.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
-[eva] share/libc/netdb.c:62:
+ Called from share/libc/netdb.c:63.
+[eva] share/libc/netdb.c:63:
function Frama_C_interval: precondition 'order' got status valid.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:62.
+ Called from share/libc/netdb.c:63.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:67.
-[eva] share/libc/netdb.c:67:
+ Called from share/libc/netdb.c:68.
+[eva] share/libc/netdb.c:68:
function Frama_C_interval: precondition 'order' got status valid.
[eva] Done for function Frama_C_interval
[eva] computing for function Frama_C_interval <- getaddrinfo <- main.
- Called from share/libc/netdb.c:68.
-[eva] share/libc/netdb.c:68:
+ Called from share/libc/netdb.c:69.
+[eva] share/libc/netdb.c:69:
function Frama_C_interval: precondition 'order' got status valid.
[eva] Done for function Frama_C_interval
[eva] Recording results for getaddrinfo
@@ -168,6 +171,83 @@
[eva] tests/libc/netdb_c.c:69:
function freeaddrinfo: precondition 'addrinfo_valid' got status valid.
[eva] Done for function freeaddrinfo
+[eva] computing for function gethostbyname <- main.
+ Called from tests/libc/netdb_c.c:71.
+[eva] computing for function res_search <- gethostbyname <- main.
+ Called from share/libc/netdb.c:139.
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] using specification for function Frama_C_char_interval
+[eva] share/libc/netdb.c:97:
+ function Frama_C_char_interval: precondition 'order' got status valid.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] share/libc/netdb.c:96: starting to merge loop iterations
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_char_interval <- res_search <-
+ gethostbyname <- main.
+ Called from share/libc/netdb.c:97.
+[eva] Done for function Frama_C_char_interval
+[eva] computing for function Frama_C_interval <- res_search <- gethostbyname <-
+ main.
+ Called from share/libc/netdb.c:100.
+[eva] share/libc/netdb.c:100:
+ function Frama_C_interval: precondition 'order' got status valid.
+[eva] Done for function Frama_C_interval
+[eva] Recording results for res_search
+[eva] Done for function res_search
+[eva] computing for function Frama_C_nondet <- gethostbyname <- main.
+ Called from share/libc/netdb.c:142.
+[eva] using specification for function Frama_C_nondet
+[eva] Done for function Frama_C_nondet
+[eva] computing for function inet_addr <- gethostbyname <- main.
+ Called from share/libc/netdb.c:145.
+[eva] using specification for function inet_addr
+[eva] share/libc/netdb.c:145:
+ function inet_addr: precondition 'valid_arg' got status valid.
+[eva] Done for function inet_addr
+[eva] share/libc/netdb.c:146: Call to builtin memcpy
+[eva] share/libc/netdb.c:146:
+ function memcpy: precondition 'valid_dest' got status valid.
+[eva] share/libc/netdb.c:146:
+ function memcpy: precondition 'valid_src' got status valid.
+[eva] share/libc/netdb.c:146:
+ function memcpy: precondition 'separation' got status valid.
+[eva] share/libc/string.h:98:
+ cannot evaluate ACSL term, unsupported ACSL construct: logic function memcmp
+[eva] computing for function strncpy <- gethostbyname <- main.
+ Called from share/libc/netdb.c:147.
+[eva] using specification for function strncpy
+[eva] share/libc/netdb.c:147:
+ function strncpy: precondition 'valid_string_src' got status valid.
+[eva] share/libc/netdb.c:147:
+ function strncpy: precondition 'room_nstring' got status valid.
+[eva] share/libc/netdb.c:147:
+ function strncpy: precondition 'separation' got status valid.
+[eva] share/libc/string.h:369:
+ cannot evaluate ACSL term, unsupported ACSL construct: logic function strcmp
+[eva] Done for function strncpy
+[eva] Recording results for gethostbyname
+[eva] Done for function gethostbyname
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
@@ -175,20 +255,42 @@
__fc_errno ∈ [--..--]
__fc_heap_status ∈ [--..--]
Frama_C_entropy_source ∈ [--..--]
- result ∈ {{ &__malloc_getaddrinfo_l55 }} or UNINITIALIZED
+ result ∈ {{ &__malloc_getaddrinfo_l56 }} or UNINITIALIZED
__retres ∈ [-11..0]
- __malloc_getaddrinfo_l55.ai_flags ∈ {0} or UNINITIALIZED
+ __malloc_getaddrinfo_l56.ai_flags ∈ {0} or UNINITIALIZED
.ai_family ∈ [0..43] or UNINITIALIZED
.ai_socktype ∈
{0; 1; 2; 3; 4; 5} or UNINITIALIZED
.ai_protocol ∈ [0..256] or UNINITIALIZED
.ai_addrlen ∈ {16} or UNINITIALIZED
.ai_addr ∈
- {{ &__malloc_getaddrinfo_l57 }} or UNINITIALIZED
+ {{ &__malloc_getaddrinfo_l58 }} or UNINITIALIZED
.ai_canonname ∈ {{ "dummy" }} or UNINITIALIZED
.ai_next ∈ {0} or UNINITIALIZED
- __malloc_getaddrinfo_l57.sa_family ∈ [0..43]
+ __malloc_getaddrinfo_l58.sa_family ∈ [0..43]
.sa_data[0..13] ∈ [--..--]
+[eva:final-states] Values at end of function res_search:
+ Frama_C_entropy_source ∈ [--..--]
+ buf[0..1] ∈ [--..--]
+ [2..126] ∈ [--..--] or UNINITIALIZED
+ [127] ∈ {0}
+[eva:final-states] Values at end of function gethostbyname:
+ Frama_C_entropy_source ∈ [--..--]
+ __fc_ghbn.host.h_name ∈ {{ NULL ; &__fc_ghbn.hostbuf[0] }}
+ .host.h_aliases ∈ {{ NULL ; &__fc_ghbn.host_aliases[0] }}
+ .host.h_addrtype ∈ {2}
+ .host.h_length ∈ {4}
+ .host.h_addr_list ∈ {{ NULL ; &__fc_ghbn.h_addr_ptrs[0] }}
+ .host_addr[0..3] ∈ [--..--]
+ .h_addr_ptrs[0] ∈ {{ NULL ; (char *)&__fc_ghbn.host_addr }}
+ {.h_addr_ptrs[1..2]; .host_aliases[0..1]} ∈ {0}
+ .hostbuf[0..126] ∈ [--..--]
+ .hostbuf[127] ∈ {0}
+ buf[0..1] ∈ [--..--]
+ [2..126] ∈ [--..--] or UNINITIALIZED
+ [127] ∈ {0}
+ n ∈ [-1..128]
+ __retres ∈ {{ NULL ; &__fc_ghbn.host }}
[eva:final-states] Values at end of function main:
__fc_errno ∈ [--..--]
__fc_heap_status ∈ [--..--]
@@ -196,24 +298,35 @@
__fc_fds[0..1023] ∈ {0}
__fc_sockfds[0..1023] ∈ [--..--]
__fc_socket_counter ∈ [--..--]
+ __fc_ghbn.host.h_name ∈ {{ NULL ; &__fc_ghbn.hostbuf[0] }}
+ .host.h_aliases ∈ {{ NULL ; &__fc_ghbn.host_aliases[0] }}
+ .host.h_addrtype ∈ {2}
+ .host.h_length ∈ {4}
+ .host.h_addr_list ∈ {{ NULL ; &__fc_ghbn.h_addr_ptrs[0] }}
+ .host_addr[0..3] ∈ [--..--]
+ .h_addr_ptrs[0] ∈ {{ NULL ; (char *)&__fc_ghbn.host_addr }}
+ {.h_addr_ptrs[1..2]; .host_aliases[0..1]} ∈ {0}
+ .hostbuf[0..126] ∈ [--..--]
+ .hostbuf[127] ∈ {0}
hints.ai_flags ∈ {1}
.ai_family ∈ {0}
.ai_socktype ∈ {2}
{.ai_protocol; .ai_addrlen; .ai_addr; .ai_canonname; .ai_next} ∈ {0}
- result ∈ {{ &__malloc_getaddrinfo_l55 }}
- rp ∈ {{ &__malloc_getaddrinfo_l55 }}
+ result ∈ {{ &__malloc_getaddrinfo_l56 }}
+ rp ∈ {{ &__malloc_getaddrinfo_l56 }}
sfd ∈ [0..1023]
s ∈ {0}
addr ∈ {{ "localhost" }}
+ h ∈ {{ NULL ; &__fc_ghbn.host }}
__retres ∈ {0}
S___fc_stderr[0..1] ∈ [--..--]
- __malloc_getaddrinfo_l55.ai_flags ∈ {0}
+ __malloc_getaddrinfo_l56.ai_flags ∈ {0}
.ai_family ∈ [0..43]
.ai_socktype ∈ {0; 1; 2; 3; 4; 5}
.ai_protocol ∈ [0..256]
.ai_addrlen ∈ {16}
- .ai_addr ∈ {{ &__malloc_getaddrinfo_l57 }}
+ .ai_addr ∈ {{ &__malloc_getaddrinfo_l58 }}
.ai_canonname ∈ {{ "dummy" }}
.ai_next ∈ {0}
- __malloc_getaddrinfo_l57.sa_family ∈ [0..43]
+ __malloc_getaddrinfo_l58.sa_family ∈ [0..43]
.sa_data[0..13] ∈ [--..--]
diff --git a/tests/libc/oracle/stdlib_c.0.res.oracle b/tests/libc/oracle/stdlib_c.0.res.oracle
index b95eac34de167bf145daa4266e881ffb644afe7a..1a7d60180779c859e8ad53b009b2d574aa0ec047 100644
--- a/tests/libc/oracle/stdlib_c.0.res.oracle
+++ b/tests/libc/oracle/stdlib_c.0.res.oracle
@@ -76,9 +76,42 @@
[eva:malloc] tests/libc/stdlib_c.c:32:
resizing variable `__calloc_w_main_l32'
(0..31/34359738367) to fit 0..63/34359738367
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:37.
+[eva] share/libc/stdlib.c:197:
+ assertion 'alignment_is_a_suitable_power_of_two' got status valid.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200: allocating variable __malloc_posix_memalign_l200
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:38.
+[eva] using specification for function free
+[eva] tests/libc/stdlib_c.c:38: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:38:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:39.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200:
+ allocating variable __malloc_posix_memalign_l200_0
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:40.
+[eva] tests/libc/stdlib_c.c:40: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:40:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
+[eva:final-states] Values at end of function posix_memalign:
+ __fc_heap_status ∈ [--..--]
+ p_al0 ∈ {{ NULL ; &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ NULL ; &__malloc_posix_memalign_l200_0[0] }} or UNINITIALIZED
+ __retres ∈ {0; 12}
[eva:final-states] Values at end of function main:
__fc_heap_status ∈ [--..--]
Frama_C_entropy_source ∈ [--..--]
@@ -87,5 +120,9 @@
q ∈ {{ NULL ; &__calloc_main_l21[0] }}
r ∈ {0}
s ∈ {{ NULL ; &__calloc_w_main_l32[0] }}
+ p_al0 ∈ {{ NULL ; &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ NULL ; &__malloc_posix_memalign_l200_0[0] }}
+ p_memal_res ∈ {0; 12}
+ p_memal_res2 ∈ {0; 12}
__retres ∈ {0}
__calloc_w_main_l32[0..1073741823] ∈ {0; 42}
diff --git a/tests/libc/oracle/stdlib_c.1.res.oracle b/tests/libc/oracle/stdlib_c.1.res.oracle
index 8dd967128d5fac44717cbb3a39886115ce154149..9021fc4d9d1690f4816abb040418148419280ab1 100644
--- a/tests/libc/oracle/stdlib_c.1.res.oracle
+++ b/tests/libc/oracle/stdlib_c.1.res.oracle
@@ -95,9 +95,42 @@
[eva:malloc] tests/libc/stdlib_c.c:32:
resizing variable `__calloc_w_main_l32'
(0..31/34359738367) to fit 0..191/34359738367
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:37.
+[eva] share/libc/stdlib.c:197:
+ assertion 'alignment_is_a_suitable_power_of_two' got status valid.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200: allocating variable __malloc_posix_memalign_l200
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:38.
+[eva] using specification for function free
+[eva] tests/libc/stdlib_c.c:38: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:38:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:39.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200:
+ allocating variable __malloc_posix_memalign_l200_0
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:40.
+[eva] tests/libc/stdlib_c.c:40: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:40:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
+[eva:final-states] Values at end of function posix_memalign:
+ __fc_heap_status ∈ [--..--]
+ p_al0 ∈ {{ &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ &__malloc_posix_memalign_l200_0[0] }} or UNINITIALIZED
+ __retres ∈ {0}
[eva:final-states] Values at end of function main:
__fc_heap_status ∈ [--..--]
Frama_C_entropy_source ∈ [--..--]
@@ -106,5 +139,9 @@
q ∈ {{ NULL ; &__calloc_main_l21[0] }}
r ∈ {0}
s ∈ {{ NULL ; &__calloc_w_main_l32[0] }}
+ p_al0 ∈ {{ &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ &__malloc_posix_memalign_l200_0[0] }}
+ p_memal_res ∈ {0}
+ p_memal_res2 ∈ {0}
__retres ∈ {0}
__calloc_w_main_l32[0..1073741823] ∈ {0; 42}
diff --git a/tests/libc/oracle/stdlib_c.2.res.oracle b/tests/libc/oracle/stdlib_c.2.res.oracle
index 8d66691a343b130e4ffd82e0d83ffecc8421c366..c70cca5c9ec4c02a371d875dd9c5978ed6f15c83 100644
--- a/tests/libc/oracle/stdlib_c.2.res.oracle
+++ b/tests/libc/oracle/stdlib_c.2.res.oracle
@@ -94,6 +94,34 @@
[eva] Done for function memset
[eva] Recording results for calloc
[eva] Done for function calloc
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:37.
+[eva] share/libc/stdlib.c:197:
+ assertion 'alignment_is_a_suitable_power_of_two' got status valid.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200: allocating variable __malloc_posix_memalign_l200
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:38.
+[eva] using specification for function free
+[eva] tests/libc/stdlib_c.c:38: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:38:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
+[eva] computing for function posix_memalign <- main.
+ Called from tests/libc/stdlib_c.c:39.
+[eva] share/libc/stdlib.c:200: Call to builtin Frama_C_malloc_by_stack
+[eva] share/libc/stdlib.c:200:
+ allocating variable __malloc_posix_memalign_l200_0
+[eva] Recording results for posix_memalign
+[eva] Done for function posix_memalign
+[eva] computing for function free <- main.
+ Called from tests/libc/stdlib_c.c:40.
+[eva] tests/libc/stdlib_c.c:40: Warning: ignoring unsupported \allocates clause
+[eva] tests/libc/stdlib_c.c:40:
+ function free: precondition 'freeable' got status valid.
+[eva] Done for function free
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
@@ -110,6 +138,11 @@
__malloc_calloc_l72[0..3] ∈ [--..--] or UNINITIALIZED
__malloc_calloc_l72_0[0..4294967291] ∈ [--..--] or UNINITIALIZED
__malloc_w_calloc_l72_1[0..4294967291] ∈ [--..--] or UNINITIALIZED
+[eva:final-states] Values at end of function posix_memalign:
+ __fc_heap_status ∈ [--..--]
+ p_al0 ∈ {{ NULL ; &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ NULL ; &__malloc_posix_memalign_l200_0[0] }} or UNINITIALIZED
+ __retres ∈ {0; 12}
[eva:final-states] Values at end of function main:
__fc_heap_status ∈ [--..--]
Frama_C_entropy_source ∈ [--..--]
@@ -118,6 +151,10 @@
q ∈ {{ NULL ; (int *)&__malloc_calloc_l72_0 }}
r ∈ {0}
s ∈ {{ NULL ; (int *)&__malloc_w_calloc_l72_1 }} or UNINITIALIZED
+ p_al0 ∈ {{ NULL ; &__malloc_posix_memalign_l200[0] }}
+ p_al1 ∈ {{ NULL ; &__malloc_posix_memalign_l200_0[0] }}
+ p_memal_res ∈ {0; 12}
+ p_memal_res2 ∈ {0; 12}
__retres ∈ {0}
__malloc_calloc_l72[0..3] ∈ [--..--] or UNINITIALIZED
__malloc_calloc_l72_0[0..4294967291] ∈ [--..--] or UNINITIALIZED
diff --git a/tests/libc/oracle/strings_h.res.oracle b/tests/libc/oracle/strings_h.res.oracle
index d675e204e1f114ab718cf914d67dda5be9c77ef5..5545c5be19e053286fcb4acc33a16cad2d023eef 100644
--- a/tests/libc/oracle/strings_h.res.oracle
+++ b/tests/libc/oracle/strings_h.res.oracle
@@ -55,6 +55,13 @@
[eva] tests/libc/strings_h.c:15:
function strncasecmp: precondition 'valid_string_s2' got status valid.
[eva] Done for function strncasecmp
+[eva] computing for function bzero <- main.
+ Called from tests/libc/strings_h.c:18.
+[eva] using specification for function bzero
+[eva] tests/libc/strings_h.c:18:
+ function bzero: precondition 'valid_memory_area' got status valid.
+[eva] Done for function bzero
+[eva] tests/libc/strings_h.c:19: assertion got status valid.
[eva] Recording results for main
[eva] done for function main
[eva] ====== VALUES COMPUTED ======
@@ -70,3 +77,4 @@
r3 ∈ [--..--]
r4 ∈ [--..--]
r5 ∈ [--..--]
+ s4[0..9] ∈ {0}
diff --git a/tests/libc/stdlib_c.c b/tests/libc/stdlib_c.c
index 3bb9f5f8b671b06e7652ac3745dc3dea1ccf0cfa..d265774bec565ed9ea9b83b45ff1620f44465221 100644
--- a/tests/libc/stdlib_c.c
+++ b/tests/libc/stdlib_c.c
@@ -33,5 +33,11 @@ int main() {
if (s) s[i-1] = 42;
}
+ char *p_al0, *p_al1;
+ int p_memal_res = posix_memalign((void**)&p_al0, 32, 0);
+ free(p_al0);
+ int p_memal_res2 = posix_memalign((void**)&p_al1, 32, 42);
+ free(p_al1);
+
return 0;
}
diff --git a/tests/libc/strings_h.c b/tests/libc/strings_h.c
index a1af1541ec7eae739b614e1f8cb309af73632c7b..587b961e6ef5517cf3ec3b2fd254d10c6e9dd243 100644
--- a/tests/libc/strings_h.c
+++ b/tests/libc/strings_h.c
@@ -13,4 +13,8 @@ void main() {
int r4 = strncasecmp(s1, s, 3);
if (nondet) strncasecmp(s1, s, 4);
int r5 = strncasecmp(s1, s2, 0);
+
+ char s4[10];
+ bzero(s4, 10);
+ //@ assert s4[9] == s4[8] == 0;
}
diff --git a/tests/misc/fam_with_init.i b/tests/misc/fam_with_init.i
new file mode 100644
index 0000000000000000000000000000000000000000..d7e8c5463b4468718e08c0388284d369ee08f7d5
--- /dev/null
+++ b/tests/misc/fam_with_init.i
@@ -0,0 +1,13 @@
+/* run.config
+STDOPT: +"-print"
+*/
+
+struct s {
+ int a;
+ char data[]; // FAM
+};
+
+int main() {
+ struct s s1 = {0};
+ return s1.a;
+}
diff --git a/tests/misc/oracle/fam_with_init.res.oracle b/tests/misc/oracle/fam_with_init.res.oracle
new file mode 100644
index 0000000000000000000000000000000000000000..6672d06da2e8d37ac925ffaac63821a5d1b1af3e
--- /dev/null
+++ b/tests/misc/oracle/fam_with_init.res.oracle
@@ -0,0 +1,37 @@
+[kernel] Parsing tests/misc/fam_with_init.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] Recording results for main
+[eva] done for function main
+[eva] ====== VALUES COMPUTED ======
+[eva:final-states] Values at end of function main:
+ s1 ∈ {0}
+ __retres ∈ {0}
+[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 main:
+ \result FROM \nothing
+[from] ====== END OF DEPENDENCIES ======
+[inout] Out (internal) for function main:
+ s1; __retres
+[inout] Inputs for function main:
+ \nothing
+/* Generated by Frama-C */
+struct s {
+ int a ;
+ char data[] ;
+};
+int main(void)
+{
+ int __retres;
+ struct s s1 = {.a = 0};
+ __retres = s1.a;
+ return __retres;
+}
+
+
diff --git a/tests/spec/Extend.ml b/tests/spec/Extend.ml
index 7af8c5f04b670304052fe9a601b24c4592657980..980bcae57360b3ee4084f357dec73b8539d1f77d 100644
--- a/tests/spec/Extend.ml
+++ b/tests/spec/Extend.ml
@@ -107,16 +107,16 @@ let type_bla ~typing_context ~loc:_loc l =
Ext_preds l
let () =
- Logic_typing.register_behavior_extension "foo" type_foo;
- Logic_typing.register_behavior_extension "bar" type_bar;
- Logic_typing.register_behavior_extension "bla" type_bla;
+ Logic_typing.register_behavior_extension "foo" false type_foo;
+ Logic_typing.register_behavior_extension "bar" false type_bar;
+ Logic_typing.register_behavior_extension "bla" false type_bla;
Cil_printer.register_behavior_extension "bar" print_bar;
Cil.register_behavior_extension "bar" visit_bar;
- Logic_typing.register_code_annot_next_both_extension "baz" type_baz;
- Logic_typing.register_code_annot_next_loop_extension "lfoo" type_foo;
- Logic_typing.register_code_annot_extension "ca_foo" type_foo;
- Logic_typing.register_code_annot_next_stmt_extension "ns_foo" type_foo;
- Logic_typing.register_global_extension "global_foo" type_foo
+ Logic_typing.register_code_annot_next_both_extension "baz" false type_baz;
+ Logic_typing.register_code_annot_next_loop_extension "lfoo" false type_foo;
+ Logic_typing.register_code_annot_extension "ca_foo" false type_foo;
+ Logic_typing.register_code_annot_next_stmt_extension "ns_foo" false type_foo;
+ Logic_typing.register_global_extension "global_foo" false type_foo
let run () =
Ast.compute ();
diff --git a/tests/spec/clash_double_file_bts1598.c b/tests/spec/clash_double_file_bts1598.c
index 9903d9ed17ff2676f5d353e8bb04ef51a2a17898..ca549981a5bf117bea05f296554329ef7ebe4e0d 100644
--- a/tests/spec/clash_double_file_bts1598.c
+++ b/tests/spec/clash_double_file_bts1598.c
@@ -28,6 +28,5 @@ OPT: @PTEST_FILE@ -cpp-extra-args " -Ishare/libc -nostdinc" -print -then -ocode
#include "string.h"
//#include "tgmath.h"
#include "time.h"
-#include "uchar.h"
#include "wchar.h"
#include "wctype.h"
diff --git a/tests/spec/float-acsl.i b/tests/spec/float-acsl.i
index 3e33afc86d04a3296bb6b760d4d59b1f141bd06b..41ef751a5c4be79fe7cdd8b12d24b6fd927896b7 100644
--- a/tests/spec/float-acsl.i
+++ b/tests/spec/float-acsl.i
@@ -1,3 +1,7 @@
+/* run.config*
+STDOPT: +"-kernel-msg-key printer:logic-coercions" +"-kernel-warn-key acsl-float-compare=active"
+*/
+
/*@
assigns \result \from \nothing;
ensures \le_double(\result, (double)0.0);
@@ -21,6 +25,12 @@ double minus_one(void);
*/
float minus_onef(void);
+/*@ requires x <= y;
+ assigns \result \from x,y;
+ ensures x <= \result <= y;
+*/
+float test(float x, float y);
+
void main() {
double mone = minus_one();
float monef = minus_onef();
diff --git a/tests/spec/oracle/float-acsl.res.oracle b/tests/spec/oracle/float-acsl.res.oracle
index 5489ef5e7841f791f2fffeaa10f5492b5339e044..5ef02bf9f069b305eaa338251ce54fa1f4e16d12 100644
--- a/tests/spec/oracle/float-acsl.res.oracle
+++ b/tests/spec/oracle/float-acsl.res.oracle
@@ -1,4 +1,10 @@
[kernel] Parsing tests/spec/float-acsl.i (no preprocessing)
+[kernel:acsl-float-compare] tests/spec/float-acsl.i:28: Warning:
+ comparing two float values as real values. You might want to use \le_float instead
+[kernel:acsl-float-compare] tests/spec/float-acsl.i:30: Warning:
+ comparing two float values as real values. You might want to use \le_float instead
+[kernel:acsl-float-compare] tests/spec/float-acsl.i:30: Warning:
+ comparing two float values as real values. You might want to use \le_float instead
/* Generated by Frama-C */
/*@ ensures \le_double(\result, (double)0.0);
ensures \ge_double(\result, (double)(-1.0));
@@ -22,6 +28,17 @@ double minus_one(void);
*/
float minus_onef(void);
+/*@ requires
+ /* (coercion to:℠*/x/* ) */ ≤ /* (coercion to:℠*/y/* ) */;
+ ensures
+ /* (coercion to:℠*/\old(x)/* ) */ ≤
+ /* (coercion to:℠*/\result/* ) */ ≤
+ /* (coercion to:â„ */\old(y)/* ) */;
+ assigns \result;
+ assigns \result \from x, y;
+ */
+float test(float x, float y);
+
void main(void)
{
double mone = minus_one();