updated test-suite & registry
git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7884 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Manuel Krucker
parent
824dd8fcd5
commit
8a85c00740
|
|
@ -84,6 +84,12 @@ sig
|
|||
(** Print option *)
|
||||
val opt2string : string option -> string
|
||||
(** Any kind of exceptions. *)
|
||||
val is_Class : Rep_Core.Classifier -> bool
|
||||
val is_AssoClass : Rep_Core.Classifier -> bool
|
||||
val is_Primi : Rep_Core.Classifier -> bool
|
||||
val is_Enum : Rep_Core.Classifier -> bool
|
||||
val is_Iface : Rep_Core.Classifier -> bool
|
||||
val is_Templ : Rep_Core.Classifier -> bool
|
||||
exception WFCPOG_LibraryError of string
|
||||
end
|
||||
structure WFCPOG_Library:WFCPOG_LIBRARY =
|
||||
|
|
@ -110,6 +116,24 @@ fun opt2string (NONE) = ""
|
|||
| opt2string (SOME(s)) = s
|
||||
|
||||
|
||||
fun is_Class (Class{...}) = true
|
||||
| is_Class x = false
|
||||
|
||||
fun is_AssoClass (AssociationClass{...}) = true
|
||||
| is_AssoClass x = false
|
||||
|
||||
fun is_Enum (Enumeration{...}) = true
|
||||
| is_Enum x = false
|
||||
|
||||
fun is_Templ (Template{...}) = true
|
||||
| is_Templ x = false
|
||||
|
||||
fun is_Primi (Primitive{...}) = true
|
||||
| is_Primi x = false
|
||||
|
||||
fun is_Iface (Interface{...}) = true
|
||||
| is_Iface x = false
|
||||
|
||||
fun name_of_precondition ((a:string option),(t:OclTerm)) = a
|
||||
|
||||
fun name_of_postcondition ((a:string option),(t:OclTerm)) = a
|
||||
|
|
|
|||
|
|
@ -22,6 +22,9 @@ val wfc_inf = get_wfpo supported_wfs "wfc_inf"
|
|||
val _ = trace high ("............. interface constraint loaded ...\n")
|
||||
|
||||
(** VISIBILITY CONSTRAINT **)
|
||||
val wfc_vis_class = get_wfpo supported_wfs "wfc_vis_class"
|
||||
val wfc_vis_inheritance = get_wfpo supported_wfs "wfc_vis_inheritance"
|
||||
val wfc_vis_runtime = get_wfpo supported_wfs "wfc_vis_runtime"
|
||||
val wfc_vis = get_wfpo supported_wfs "wfc_vis"
|
||||
val _ = trace high ("............. visibility constraint loaded ...\n")
|
||||
|
||||
|
|
@ -111,5 +114,5 @@ val pos = [po_cstr]
|
|||
val wfs = [wfc_vis]
|
||||
val pos = []
|
||||
*)
|
||||
val wfs = []
|
||||
val pos = [po_lsk]
|
||||
val wfs = [wfc_vis_class,wfc_vis_inheritance,wfc_vis_runtime]
|
||||
val pos = []
|
||||
|
|
|
|||
|
|
@ -1,28 +1,35 @@
|
|||
signature WFCPOG_TESTSUITE =
|
||||
sig
|
||||
val buffer : string ref
|
||||
val reset_buffer : unit -> unit
|
||||
(** Executes a test on all (default) model and returns a text output.*)
|
||||
val runTests : WFCPOG.wfpo list -> WFCPOG.wfpo list -> unit
|
||||
(** Executes a specified (string fst arg) test and returns a text output.*)
|
||||
val runTest : string -> WFCPOG.wfpo list -> WFCPOG.wfpo list -> unit
|
||||
(** Executes a test on all (default) models and returns the proof obligations.*)
|
||||
val execTests : WFCPOG.wfpo list -> WFCPOG.wfpo list -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list
|
||||
(* val execTests : WFCPOG.wfpo list -> WFCPOG.wfpo list -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list
|
||||
(** Executes a specified (string fst arg) test and returns the proof obligations.*)
|
||||
val execTest : string -> WFCPOG.wfpo list -> WFCPOG.wfpo list -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list
|
||||
*)
|
||||
(** Set Control.Print.printDepth. *)
|
||||
val set_printDepth : int -> unit
|
||||
(** Set Control.Print.printLength. *)
|
||||
val set_printLength : int -> unit
|
||||
exception WFCPOG_TestSuiteError of string
|
||||
end
|
||||
|
||||
structure WFCPOG_TestSuite : WFCPOG_TESTSUITE =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open WFCPOG
|
||||
open WFCPOG_Refine_Constraint
|
||||
open WFCPOG_Registry
|
||||
open OclLibrary
|
||||
|
||||
exception WFCPOG_TestSuiteError of string
|
||||
|
||||
type testcase =
|
||||
{
|
||||
|
|
@ -33,6 +40,14 @@ type testcase =
|
|||
|
||||
exception TestSuitError of string
|
||||
|
||||
val buffer = ref ""
|
||||
|
||||
fun reset_buffer () =
|
||||
let
|
||||
val _ = buffer:=("")
|
||||
in
|
||||
()
|
||||
end
|
||||
|
||||
val prefix = "../../../hol-ocl/examples/"
|
||||
|
||||
|
|
@ -127,38 +142,75 @@ fun set_printLength x =
|
|||
fun add_dot 1 = ["."]
|
||||
| add_dot x = (".")::(add_dot (x-1))
|
||||
|
||||
fun insert_dots string = String.concat (add_dot (40 - String.size(string)))
|
||||
fun insert_dots string = if (String.size(string) >= 100)
|
||||
then raise WFCPOG_TestSuiteError ("Name of wfpo to long...\n")
|
||||
else String.concat (add_dot (100 - String.size(string)))
|
||||
|
||||
|
||||
fun start_tests model [] = []
|
||||
fun start_tests model [] = ()
|
||||
| start_tests model (h::wfpos) =
|
||||
case (apply_of h) of
|
||||
WFC (a) =>
|
||||
(let
|
||||
let
|
||||
val _ = trace wgen ("Testing a wellformed constraint: \n")
|
||||
val check = check_wfc model h
|
||||
handle WFCPOG.WFCPOG_WFC_FailedException s =>
|
||||
let
|
||||
val _ = trace wgen ("WFC_Failed_Exception handler ...\n")
|
||||
val _ = buffer:=((!buffer)^s)
|
||||
in
|
||||
false
|
||||
end
|
||||
in
|
||||
case check_wfc model h of
|
||||
false => (((name_of h) ^ (insert_dots (name_of h)) ^ "[FAILED]\n"))::(start_tests model wfpos)
|
||||
| true => (((name_of h) ^ (insert_dots (name_of h)) ^ "[OK]\n"))::(start_tests model wfpos)
|
||||
case check of
|
||||
false =>
|
||||
let
|
||||
val _ = trace wgen ("test is false ...\n")
|
||||
val mes = ("\n" ^ (name_of h) ^ (insert_dots (name_of h)) ^ "[FAILED]\n")
|
||||
val _ = trace wgen mes
|
||||
val _ = buffer:=(!buffer)^mes
|
||||
val _ = trace wgen ("results logged in buffer ...\n")
|
||||
in
|
||||
(start_tests model wfpos)
|
||||
end
|
||||
| true =>
|
||||
let
|
||||
val _ = trace wgen ("test is true ...\n")
|
||||
val name = WFCPOG.name_of h
|
||||
val mes = ("\n" ^ name ^ (insert_dots (name)) ^ "[OK]\n")
|
||||
val _ = trace wgen mes
|
||||
val _ = buffer:=(!buffer)^mes
|
||||
val _ = trace wgen ("results logged in buffer ...\n")
|
||||
in
|
||||
(start_tests model wfpos)
|
||||
end
|
||||
end
|
||||
handle WFCPOG.WFCPOG_WFC_FailedException s =>
|
||||
let
|
||||
val _ = trace exce s
|
||||
in
|
||||
((name_of h) ^ (insert_dots (name_of h)) ^ "[RefineEXCP]\n")::(start_tests model wfpos)
|
||||
end
|
||||
| x =>((name_of h) ^ (insert_dots (name_of h)) ^ "[ERROR]\n")::(start_tests model wfpos)
|
||||
)
|
||||
| POG (a) =>
|
||||
(let
|
||||
val _ = trace wgen ("Testing a proof obligation constraint: \n")
|
||||
in
|
||||
case generate_po model h of
|
||||
(wfc,list) => ((name_of h ^ (insert_dots (name_of h)) ^ "[ " ^ (Int.toString(List.length(list))) ^ " Terms ]\n"))::(start_tests model wfpos)
|
||||
end
|
||||
handle x =>((name_of h ^ (insert_dots (name_of h)) ^ "[ERROR]\n"))::(start_tests model wfpos)
|
||||
)
|
||||
|
||||
let
|
||||
val _ = trace wgen ("Testing a proof obligation constraint: \n")
|
||||
val pos = generate_po model h
|
||||
handle WFCPOG.WFCPOG_WFC_FailedException s =>
|
||||
let
|
||||
val _ = buffer:=((!buffer)^s)
|
||||
in
|
||||
(h,[(["Exception"],(Variable("x",OclVoid)))])
|
||||
end
|
||||
in
|
||||
case pos of
|
||||
(h,[(["Exception"],(Variable("x",OclVoid)))]) =>
|
||||
let
|
||||
val _ = buffer:=(!buffer)^((name_of h ^ (insert_dots (name_of h)) ^ "[DEPENDING WFC NOT HOLD]\n"))
|
||||
in
|
||||
(start_tests model wfpos)
|
||||
end
|
||||
| (wfc,list) =>
|
||||
let
|
||||
val _ = buffer:=(!buffer)^((name_of h ^ (insert_dots (name_of h)) ^ "[ " ^ (Int.toString(List.length(list))) ^ " Terms ]\n"))
|
||||
in
|
||||
(start_tests model wfpos)
|
||||
end
|
||||
end
|
||||
|
||||
fun exec_test model (h:wfpo as WFPO{name,identifier,description,recommended,depends,recommends,apply,data}) =
|
||||
(case (apply_of h) of
|
||||
WFC (a) =>
|
||||
|
|
@ -192,24 +244,28 @@ fun exec_tests (tc:testcase) wfs pos =
|
|||
fun test (tc:testcase) wfs pos =
|
||||
let
|
||||
val i_model = ModelImport.import (#uml tc) (#ocl tc) []
|
||||
|
||||
val (clist,alist) = Rep_Core.normalize_ext i_model
|
||||
val model = ((clist@oclLib),(alist))
|
||||
val msg_list = start_tests model (wfs@pos)
|
||||
val _ = trace wgen ("Model of testcase loaded ...\n")
|
||||
val _ = start_tests model (wfs@pos)
|
||||
val _ = trace wgen ("Test finished ...\n")
|
||||
|
||||
in
|
||||
String.concat (msg_list)
|
||||
()
|
||||
end
|
||||
|
||||
fun printResult s = print s
|
||||
|
||||
fun print_tc (tc:testcase)=
|
||||
let
|
||||
val start_tc = "\n\n\n***************************************************\n\n"
|
||||
val name = (#name tc) ^ "\n\n"
|
||||
val s1 = "\n\n\n***************************************************\n"
|
||||
val s2 = "***************************************************\n"
|
||||
val name = (#name tc)
|
||||
val s3 = "\n***************************************************\n"
|
||||
in
|
||||
start_tc^name
|
||||
s1^s2^name^s3
|
||||
end
|
||||
(*
|
||||
fun execTest name wfs pos =
|
||||
let
|
||||
val _ = trace high ("runTest ...\n")
|
||||
|
|
@ -224,27 +280,38 @@ fun execTest name wfs pos =
|
|||
|
||||
fun execTests wfs pos =
|
||||
List.concat (List.map (fn a => exec_tests a wfs pos) testcases)
|
||||
|
||||
*)
|
||||
fun runTest name wfs pos =
|
||||
let
|
||||
val _ = trace high ("runTest ...\n")
|
||||
val _ = trace wgen ("Starts runing one test ...\n")
|
||||
val _ = reset_buffer()
|
||||
val tc = valOf (List.find (fn a => name = (#name a)) testcases)
|
||||
val string = (print_tc tc)^(test tc wfs pos)
|
||||
val output = if (String.isSubstring "[Error]" string)
|
||||
then print(string^"\n\n !!!!!!!!!! WFCPOG still contains bugs !!!!!!!!!!!!!\n\n\n")
|
||||
else print (string^"\n\n !!!!!!!!!! Congratulations, no bugs !!!!!!!!!!!!!!\n\n\n")
|
||||
in
|
||||
output
|
||||
val _ = trace wgen ("Accessing model ...\n")
|
||||
val s1 = (print_tc tc)
|
||||
val _ = (test tc wfs pos)
|
||||
val _ = buffer:=s1^(!buffer)
|
||||
in
|
||||
if (String.isSubstring "[Error]" (!buffer))
|
||||
then print ((!buffer)^"\n\n !!!!!!!!!! WFCPOG still contains bugs !!!!!!!!!!!!!\n\n\n")
|
||||
else print ((!buffer)^"\n\n !!!!!!!!!! Congratulations, no bugs !!!!!!!!!!!!!!\n\n\n")
|
||||
end
|
||||
|
||||
|
||||
fun runTests wfs pos =
|
||||
let
|
||||
val msg_list = List.map (fn a => (print_tc a)^(test a wfs pos)) testcases
|
||||
val string = String.concat msg_list
|
||||
val _ = trace wgen ("Starts running tests ...\n")
|
||||
val _ = reset_buffer()
|
||||
val _ = List.map (fn a =>
|
||||
let
|
||||
val s1 = (print_tc a)
|
||||
val _ = buffer:=(!buffer)^s1
|
||||
val _ = (test a wfs pos)
|
||||
in
|
||||
()
|
||||
end) testcases
|
||||
in
|
||||
if (String.isSubstring "[ERROR]" string)
|
||||
then print (string^"\n\n !!!!!!!!!! WFCPOG still contains bugs !!!!!!!!!!!!!\n\n\n")
|
||||
else print (string^"\n\n !!!!!!!!!! Congratulations, no bugs !!!!!!!!!!!!!!\n\n\n")
|
||||
if (String.isSubstring "[ERROR]" (!buffer))
|
||||
then print ((!buffer)^"\n\n !!!!!!!!!! WFCPOG still contains bugs !!!!!!!!!!!!!\n\n\n")
|
||||
else print ((!buffer)^"\n\n !!!!!!!!!! Congratulations, no bugs !!!!!!!!!!!!!!\n\n\n")
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -196,15 +196,55 @@ val supported_wfs = [
|
|||
data = Datatab.empty
|
||||
},
|
||||
WFCPOG.WFPO{
|
||||
identifier = "wfc_vis",
|
||||
name = "WFC Visibility Consistency",
|
||||
description = "Checks if the accessed operations in preconditions/postconditions/invariants are visible.\n",
|
||||
identifier = "wfc_vis_class",
|
||||
name = "WFC Visibility Consistency (class)",
|
||||
description = "Checks if the visibility of the class is at least as visible as the most visible member.\n",
|
||||
recommended = true,
|
||||
depends = [],
|
||||
recommends = [],
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.are_conditions_visible),
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.model_entity_consistency),
|
||||
data = Datatab.empty
|
||||
},
|
||||
},
|
||||
WFCPOG.WFPO{
|
||||
identifier = "wfc_vis_inheritance",
|
||||
name = "WFC Visibility Consistency (inheritance)",
|
||||
description = "Checks if the modificators of overriden features are maintained in the subclasses.\n",
|
||||
recommended = true,
|
||||
depends = [],
|
||||
recommends = [],
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.model_inheritance_consistency),
|
||||
data = Datatab.empty
|
||||
},
|
||||
WFCPOG.WFPO{
|
||||
identifier = "wfc_vis_runtime",
|
||||
name = "WFC Visibility Consistency (runtime)",
|
||||
description = "Runtime checking/enforcement in mind:\n pre-condition, post-conditions, invariants are shall only contain \n calls to visible features (i.e., public features of other classes, \n package features of other classes within the same package, \n protected features of superclasses, and own private features).\n",
|
||||
recommended = false,
|
||||
depends = [],
|
||||
recommends = [],
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.constraint_check_by_runtime_consistency),
|
||||
data = Datatab.empty
|
||||
},
|
||||
WFCPOG.WFPO{
|
||||
identifier = "wfc_vis_runtime",
|
||||
name = "WFC Visibility Consistency (complete)",
|
||||
description = "Runtime checking/enforcement in mind:\n pre-condition, post-conditions, invariants are shall only contain \n calls to visible features (i.e., public features of other classes, \n package features of other classes within the same package, \n protected features of superclasses, and own private features).\n",
|
||||
recommended = false,
|
||||
depends = [],
|
||||
recommends = [],
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.constraint_check_by_runtime_consistency),
|
||||
data = Datatab.empty
|
||||
},WFCPOG.WFPO{
|
||||
identifier = "wfc_vis",
|
||||
name = "WFC Visibility Consistency (complete)",
|
||||
description = "Three checks forced: \n wfc_vis_runtime \n wfc_vis_class \n wfc_vis_inheritance",
|
||||
recommended = false,
|
||||
depends = ["wfc_vis_class","wfc_vis_inheritance"],
|
||||
recommends = [],
|
||||
apply = WFCPOG.WFC(WFCPOG_Visibility_Constraint.constraint_check_by_runtime_consistency),
|
||||
data = Datatab.empty
|
||||
},
|
||||
|
||||
(* TODO: insert this constraint for having a default value. *)
|
||||
(* *)
|
||||
(* (WFCPOG_Taxonomy_Constraint.WFCPOG_TAX_Data.put ({key=9,max_depth=5}) tax_workaround) *)
|
||||
|
|
@ -392,6 +432,7 @@ fun is_pog (WFCPOG.WFPO wfpo) = case #apply wfpo of
|
|||
fun process_depends [] data model acc = acc
|
||||
| process_depends (h::tail) data model acc =
|
||||
let
|
||||
val _ = trace function_calls ("WFCPOG_Registry.process_depends\n")
|
||||
fun set_data (new_data:Object.T table) (WFCPOG.WFPO{identifier,name,description,recommended,depends,recommends,apply,data}) =
|
||||
WFCPOG.WFPO{
|
||||
identifier = identifier,
|
||||
|
|
@ -403,7 +444,6 @@ fun process_depends [] data model acc = acc
|
|||
apply=apply,
|
||||
data=new_data
|
||||
}
|
||||
val _ = trace function_calls ("WFCPOG_Registry.process_depends\n")
|
||||
val wfpo = set_data data (get_wfpo supported h)
|
||||
val _ = trace wgen ("Dependent wfpo " ^ (name_of wfpo) ^ " found.\n")
|
||||
val res =
|
||||
|
|
|
|||
Loading…
Reference in New Issue