[e-acsl] license

[e-acsl] do not stop anymore when detecting an invalid/unsupported annotation
[e-acsl] tests for invalid quantifications

src/plugins/e-acsl/Makefile.in

@@ -33,7 +33,7 @@ PLUGIN_DIR ?=.
 PLUGIN_ENABLE:=@ENABLE_E_ACSL@
 PLUGIN_DYNAMIC:=@DYNAMIC_E_ACSL@
 PLUGIN_NAME:=E_ACSL
-PLUGIN_CMO:= local_config options read_header misc mpz env visit main
+PLUGIN_CMO:= local_config options read_header error misc mpz env visit main
 PLUGIN_HAS_MLI:=yes
 
 # Enable -warn-error, but do not distribute the plug-in with this option being

src/plugins/e-acsl/TODO

@@ -4,7 +4,6 @@
 
 - quantifications sur les entiers
 - mixed assumes and ensures in contracts
-- pas d'arrêt brutal en cas de feature non implémentée
 - utiliser Options.use_asserts
 
 ########

src/plugins/e-acsl/env.ml

@@ -283,7 +283,7 @@ let stmt_of_label env = function
   | StmtLabel { contents = stmt } -> stmt
   | LogicLabel(_, label) when label = "Here" -> 
     (match env.visitor#current_stmt with
-    | None -> Misc.not_yet "label \"Here\" in function contract"
+    | None -> Error.not_yet "label \"Here\" in function contract"
     | Some s -> s)
   | LogicLabel(_, label) when label = "Old" || label = "Pre" -> 
     (try Kernel_function.find_first_stmt (Extlib.the env.visitor#current_kf)

src/plugins/e-acsl/error.ml

+(**************************************************************************)
+(*                                                                        *)
+(*  This file is part of the E-ACSL plug-in of Frama-C.                   *)
+(*                                                                        *)
+(*  Copyright (C) 2011                                                    *)
+(*    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).            *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Typing_error of string
+let untypable s = raise (Typing_error s)
+
+exception Not_yet of string
+let not_yet s = raise (Not_yet s)
+
+module Nb_typing = 
+  State_builder.Ref
+    (Datatype.Int)
+    (struct
+      let name = "E_ACSL.Error.Nb_typing"
+      let default () = 0
+      let dependencies = [ Ast.self ]
+      let kind = `Correctness
+     end)
+
+let nb_untypable = Nb_typing.get
+
+module Nb_not_yet = 
+  State_builder.Ref
+    (Datatype.Int)
+    (struct
+      let name = "E_ACSL.Error.Nb_not_yet"
+      let default () = 0
+      let dependencies = [ Ast.self ]
+      let kind = `Correctness
+     end)
+
+let nb_not_yet = Nb_not_yet.get
+
+let handle f x = 
+  try
+    f x
+  with
+  | Typing_error s ->
+    let msg = Format.sprintf "@[invalid E-ACSL construct@ `%s'.@]" s in
+    Options.warning ~current:true "@[%s@ Ignoring annotation.@]" msg;
+    Nb_typing.set (Nb_typing.get () + 1);
+    x
+  | Not_yet s ->
+    let msg = 
+      Format.sprintf "@[E-ACSL construct@ `%s'@ is not yet supported.@]" s
+    in 
+    Options.warning ~current:true "@[%s@ Ignoring annotation.@]" msg;
+    Nb_not_yet.set (Nb_not_yet.get () + 1);
+    x
+
+(*
+Local Variables:
+compile-command: "make"
+End:
+*)

src/plugins/e-acsl/error.mli

+(**************************************************************************)
+(*                                                                        *)
+(*  This file is part of the E-ACSL plug-in of Frama-C.                   *)
+(*                                                                        *)
+(*  Copyright (C) 2011                                                    *)
+(*    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).            *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Handling errors. *)
+
+val untypable: string -> 'a
+(** type error built from the given argument. *)
+  
+val not_yet: string -> 'a
+(** not_yet_implemented error built from the given argument. *)
+  
+val handle: ('a -> 'a) -> 'a -> 'a
+(** run the closure with the given argument and handle potential errors. *)
+
+val nb_untypable: unit -> int
+(** Number of untypable annotations. *)
+
+val nb_not_yet: unit -> int
+(** Number of not-yet-supported annotations. *)
+
+(*
+Local Variables:
+compile-command: "make"
+End:
+*)

src/plugins/e-acsl/license/CEA_LGPL

+
+This file is part of the E-ACSL plug-in of Frama-C.
+
+Copyright (C) 2011
+  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).
+

src/plugins/e-acsl/license/headache_config.txt

+##################
+# Objective Caml #
+##################
+| ".*\.mly"      -> frame open:"/*" line:"*" close:"*/"
+| ".*\.ml[il4]?.*" -> frame open:"(*" line:"*" close:"*)"
+
+############
+# C source #
+############
+| ".*\.h"      -> frame open:"/*" line:"*" close:"*/"
+| ".*\.c"      -> frame open:"/*" line:"*" close:"*/"
+| ".*\.ast"    -> frame open:"//" line:" " close:" "
+| ".*\.cc"     -> frame open:"/*" line:"*" close:"*/"
+| "perfcount.c.in" -> frame open: "/*" line: "*" close: "*/"
+
+#######
+# Asm #
+#######
+| ".*\.S"      -> frame open:"/*" line:"*" close:"*/"
+
+#############
+# Configure #
+#############
+| ".*config\.h\.in" -> frame open:"/*"  line:"*" close:"*/"
+| ".*configure\..*" -> frame open:"#"  line:"#" close:"#"
+
+############
+# Makefile #
+############
+| ".*Makefile\..*" -> frame open:"#"  line:"#" close:"#"
+
+#################
+# Shell scripts #
+#################
+| ".*\.sh" -> frame open:"#"  line:"#" close:"#"
+
+#########################
+# MS-Windows Ressources #
+#########################
+| ".*\.rc" -> frame open:"#"  line:"#" close:"#"
+
+#############
+# man pages #
+#############
+| ".*\.[1-9]" -> frame open:".\\\"" line: " " close:""
+
+#############
+# Why files #
+#############
+| ".*\.why" -> frame open: "(*" line: "*" close: "*)"
+| ".*\.why\.src" -> frame open: "(*" line: "*" close: "*)"
+
+#############
+# Coq files #
+#############
+| ".*\.v" -> frame open: "(*" line: "*" close: "*)"
+
+########
+# HTML #
+########
+| ".*\.htm.*" -> frame open: "<!--" line: " " close: "-->"
+
+#######
+# CSS #
+#######
+| ".*\.css" -> frame open: "/*" line: "*" close: "*/"
+# plug-in's ocamldoc introductions
+| "intro_.*\.txt" -> frame open: "@ignore" line: " " close: ""
+
+##############
+# Emacs Lisp #
+##############
+| ".*\.el" -> frame open: ";" line: ";" close:";"
+
+##############
+# Misc files #
+##############
+| "make_release" -> frame open:"#"  line:"#" close:"#"
+| "FAQ" -> frame open:"#"  line:"#" close:"#"

src/plugins/e-acsl/main.ml

@@ -21,12 +21,19 @@
 (**************************************************************************)
 
 let check () =
-  try
-    Visitor.visitFramacFileSameGlobals (Visit.do_visit false) (Ast.get ());
-    true
-  with Misc.Typing_error s ->
-    Options.error ~current:true "%s" s;
-    false
+  Visitor.visitFramacFileSameGlobals (Visit.do_visit false) (Ast.get ());
+  let t = Error.nb_untypable () in
+  let n = Error.nb_not_yet () in
+  let print msg n =
+    Options.result "@[%d annotation%s %s ignored,@ being %s.@]" 
+      n
+      (if n > 1 then "s" else "")
+      (if n > 1 then "were" else "was")
+      msg
+  in
+  print "untypable" t;
+  print "unsupported" n;
+  n + t = 0
 
 let check =
   Dynamic.register
@@ -36,18 +43,6 @@ let check =
     (Datatype.func Datatype.unit Datatype.bool)
     check
 
-let fail_check () =
-  try Visitor.visitFramacFileSameGlobals (Visit.do_visit false) (Ast.get ());
-  with Misc.Typing_error s -> Options.abort ~current:true "%s" s
-
-let fail_check =
-  Dynamic.register
-    ~plugin:"e-acsl"
-    ~journalize:true
-    "fail_check"
-    (Datatype.func Datatype.unit Datatype.unit)
-    fail_check
-
 module Resulting_projects =
   State_builder.Hashtbl
     (Datatype.String.Hashtbl)
@@ -64,11 +59,8 @@ let () = Env.global_state := Resulting_projects.self
 let generate_code =
   Resulting_projects.memo
     (fun name ->
-      try
-	let visit prj = Visit.do_visit ~prj true in
-	File.create_rebuilt_project_from_visitor ~preprocess:false name visit
-      with Misc.Typing_error s ->
-	Options.abort ~current:true "%s" s)
+      let visit prj = Visit.do_visit ~prj true in
+      File.create_rebuilt_project_from_visitor ~preprocess:false name visit)
 
 let generate_code =
   Dynamic.register
@@ -82,7 +74,7 @@ let main () =
   if Options.Run.get () then 
     ignore (generate_code (Options.Project_name.get ()))
   else
-    if Options.Check.get () then fail_check () 
+    if Options.Check.get () then ignore (check ())
 
 let () = Db.Main.extend main
 

src/plugins/e-acsl/misc.ml

@@ -24,16 +24,6 @@ open Cil_types
 open Cil_datatype
 open Cil
 
-(* ************************************************************************** *)
-(** {2 Handling errors} *)
-(* ************************************************************************** *)
-
-exception Typing_error of string
-let type_error s = raise (Typing_error s)
-
-let not_yet s =
-  Options.not_yet_implemented "construct `%s' is not yet supported." s
-
 (* ************************************************************************** *)
 (** {2 Builders} *)
 (* ************************************************************************** *)

src/plugins/e-acsl/misc.mli

@@ -25,17 +25,6 @@
 open Cil_types
 open Cil_datatype
 
-(* ************************************************************************** *)
-(** {2 Handling errors} *)
-(* ************************************************************************** *)
-
-exception Typing_error of string
-val type_error: string -> 'a
-(** @raise Typing_error with  with a message built from the given one. *)
-
-val not_yet: string -> 'a
-(** @raise Log.FeatureRequest with a message built from the given one. *)
-
 (* ************************************************************************** *)
 (** {2 Builders} *)
 (* ************************************************************************** *)

src/plugins/e-acsl/tests/e-acsl-reject/oracle/quantif.res.oracle

+tests/e-acsl-reject/quantif.i:6:[e-acsl] warning: E-ACSL construct `unguarded \forall quantification' is not yet supported.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:7:[e-acsl] warning: invalid E-ACSL construct
+                  `invalid guard (x ≡ 1) in quantification (∀ ℤ x; x ≡ 1 ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:8:[e-acsl] warning: invalid E-ACSL construct
+                  `invalid guard (0 ≤ x) in quantification (∀ int x; 0 ≤ x ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:9:[e-acsl] warning: invalid E-ACSL construct
+                  `non integer variable x in quantification (∀ float x; 0 ≤ x ∧ x ≤ 3 ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:10:[e-acsl] warning: invalid E-ACSL construct
+                  `unguarded variable y in quantification
+                  (∀ ℤ x, ℤ y; 0 ≤ x ∧ x ≤ 3 ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:11:[e-acsl] warning: invalid E-ACSL construct
+                  `unquantified variable z in quantification
+                  (∀ ℤ x; (0 ≤ x ∧ x ≤ 3) ∧ (0 ≤ z ∧ z ≤ 3) ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:12:[e-acsl] warning: invalid E-ACSL construct
+                  `invalid guard ((0 ≤ x ∧ x ≤ 3) ∨ (0 ≤ y ∧ y ≤ 3)) in quantification
+                  (∀ ℤ x, ℤ y; (0 ≤ x ∧ x ≤ 3) ∨ (0 ≤ y ∧ y ≤ 3) ⇒
+                    x ≥ 0)'.
+                  Ignoring annotation.
+tests/e-acsl-reject/quantif.i:13:[e-acsl] warning: invalid E-ACSL construct
+                  `invalid binder x+1 in quantification (∀ int x; 0 ≤ x+1 ∧ x+1 ≤ 3 ⇒ x ≥ 0)'.
+                  Ignoring annotation.
+[e-acsl] 7 annotations were ignored, being untypable.
+[e-acsl] 1 annotation was ignored, being unsupported.

src/plugins/e-acsl/tests/e-acsl-reject/oracle/valid.res.oracle

-[kernel] Plug-in e-acsl aborted because of unimplemented feature.
-         Please send a feature request at http://bts.frama-c.com with:
-         '[Plug-in e-acsl] construct `\valid' is not yet supported.'.
+tests/e-acsl-reject/valid.i:5:[e-acsl] warning: E-ACSL construct `\valid' is not yet supported. Ignoring annotation.
+[e-acsl] 0 annotation was ignored, being untypable.
+[e-acsl] 1 annotation was ignored, being unsupported.

src/plugins/e-acsl/tests/e-acsl-reject/oracle/valid_index.res.oracle

-[kernel] Plug-in e-acsl aborted because of unimplemented feature.
-         Please send a feature request at http://bts.frama-c.com with:
-         '[Plug-in e-acsl] construct `\valid_index' is not yet supported.'.
+tests/e-acsl-reject/valid_index.i:5:[e-acsl] warning: E-ACSL construct `\valid_index' is not yet supported. Ignoring annotation.
+[e-acsl] 0 annotation was ignored, being untypable.
+[e-acsl] 1 annotation was ignored, being unsupported.

src/plugins/e-acsl/tests/e-acsl-reject/oracle/valid_range.res.oracle

-[kernel] Plug-in e-acsl aborted because of unimplemented feature.
-         Please send a feature request at http://bts.frama-c.com with:
-         '[Plug-in e-acsl] construct `\valid_range' is not yet supported.'.
+tests/e-acsl-reject/valid_range.i:5:[e-acsl] warning: E-ACSL construct `\valid_range' is not yet supported. Ignoring annotation.
+[e-acsl] 0 annotation was ignored, being untypable.
+[e-acsl] 1 annotation was ignored, being unsupported.

src/plugins/e-acsl/tests/e-acsl-reject/quantif.i

+/* run.config
+   COMMENT: invalid quantifications */
+
+int main(void) {
+  int z;
+  /*@ assert \forall integer x; x >= 0; */
+  /*@ assert \forall integer x; x == 1 ==> x >= 0; */
+  /*@ assert \forall int x; 0 <= x ==> x >= 0; */
+  /*@ assert \forall float x; 0 <= x <= 3 ==> x >= 0; */
+  /*@ assert \forall integer x,y; 0 <= x <= 3 ==> x >= 0; */
+  /*@ assert \forall integer x; 0 <= x <= 3 && 0 <= z <= 3 ==> x >= 0; */
+  /*@ assert \forall integer x,y; 0 <= x <= 3 || 0 <= y <= 3 ==> x >= 0; */
+  /*@ assert \forall int x; 0 <= x+1 <= 3 ==> x >= 0; */
+  return 0;
+}

src/plugins/e-acsl/tests/e-acsl-reject/test_config

-COMMENT: -e-acsl-check set by default
-STDOPT:
+OPT: -e-acsl-check

src/plugins/e-acsl/tests/e-acsl-runtime/oracle/ptr.res.oracle

@@ -2,7 +2,8 @@ tests/e-acsl-runtime/ptr.i:12:[e-acsl] warning: missing guard for ensuring that
 :0:[e-acsl] warning: missing guard for ensuring that 0 is a valid array index
 tests/e-acsl-runtime/ptr.i:14:[e-acsl] warning: missing guard for ensuring that 2 is a valid array index
 tests/e-acsl-runtime/ptr.i:15:[e-acsl] warning: missing guard for ensuring that the given integer is C-representable
-:0:[e-acsl] warning: missing guard for ensuring that (2*sizeof(int))/sizeof((int)0x0) is a valid array index
+:0:[e-acsl] warning: missing guard for ensuring that
+                  (2*sizeof(int))/sizeof((int)0x0) is a valid array index
 tests/e-acsl-runtime/ptr.i:18:[e-acsl] warning: missing guard for ensuring that i is a valid array index
 tests/e-acsl-runtime/ptr.i:19:[e-acsl] warning: missing guard for ensuring that the given integer is C-representable
 :0:[e-acsl] warning: missing guard for ensuring that 2-i is a valid array index

src/plugins/e-acsl/tests/e-acsl-runtime/test_config

-STDOPT: +"-e-acsl" +"-then-on e-acsl" +"-check" +"-print" +"-val"
+OPT: -e-acsl -then-on e-acsl -check -print -val