From b4300e78fd8d0c65c3aa389b63429703b3536254 Mon Sep 17 00:00:00 2001 From: Manuel Krucker Date: Wed, 14 May 2008 11:12:46 +0000 Subject: [PATCH] misc git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7972 3260e6d1-4efc-4170-b0a7-36055960796d --- su4sml/src/wfcpog/liskov_constraint.sml | 6 +-- su4sml/src/wfcpog/test-data.sml | 51 +++---------------------- su4sml/src/wfcpog/test-suite.sml | 20 +--------- su4sml/src/wfcpog/wfcpog.cm | 1 + 4 files changed, 11 insertions(+), 67 deletions(-) diff --git a/su4sml/src/wfcpog/liskov_constraint.sml b/su4sml/src/wfcpog/liskov_constraint.sml index 83e818f..308f1d5 100644 --- a/su4sml/src/wfcpog/liskov_constraint.sml +++ b/su4sml/src/wfcpog/liskov_constraint.sml @@ -197,13 +197,13 @@ fun conjugate_invariants_help [] model = [] | conjugate_invariants_help (class::clist) model = let (* get the invariants of all parents *) - val parents = parents_of class model - val invs = List.map (fn a => Predicate(Variable(varcounter.nextStr(),Rep_Core.type_of a),Rep_Core.type_of a,name_of_inv a,[])) parents + val parents_and_self = (parents_of class model)@[class] + val invs = List.map (fn a => Predicate(Variable(varcounter.nextStr(),Rep_Core.type_of a),Rep_Core.type_of a,name_of_inv a,[])) parents_and_self in if (List.length(invs) = 0) then (conjugate_invariants_help clist model) else (["po_lsk_inv"]@["_"]@(name_of class)@["_"], - Rep_HolOcl_Helper.holocl_and_all invs)::(conjugate_invariants_help clist model) + conjugate_terms invs)::(conjugate_invariants_help clist model) end diff --git a/su4sml/src/wfcpog/test-data.sml b/su4sml/src/wfcpog/test-data.sml index 456bd36..8bfbdd9 100644 --- a/su4sml/src/wfcpog/test-data.sml +++ b/su4sml/src/wfcpog/test-data.sml @@ -1,3 +1,5 @@ + + open OclLibrary open Rep_Logger open WFCPOG @@ -8,10 +10,6 @@ open WFCPOG_TestSuite structure RFM_Data = WFCPOG_Refine_Constraint.WFCPOG_RFM_Data structure TAX_Data = WFCPOG_Taxonomy_Constraint.WFCPOG_TAX_Data -val _ = Control.Print.printDepth:=30 -val _ = Control.Print.printLength:=30 - -val _ = trace wgen "\n\n\n" (** ################# **) (** WELLFORMED-CHECKS **) @@ -89,49 +87,12 @@ val _ = trace high ("............. refine pog constraint loaded ...\n") val po_rfm_SR = rename_wfpo "po_rfm_SR" (RFM_Data.put ({key=10,rfm_tuple=(["AbstractOverriding"],["ConcreteOverriding"])}) po_rfm) val _ = trace high ("............. refine pog constraint loaded ...\n") - - -(* -val md0 = rename_wfpo "md0" (TAX_Data.put ({key=8,max_depth=0}) tax) -val md1 = rename_wfpo "md1" (TAX_Data.put ({key=9,max_depth=1}) tax) -val md2 = rename_wfpo "md2" (TAX_Data.put ({key=9,max_depth=2}) tax) -val md3 = rename_wfpo "md3" (TAX_Data.put ({key=9,max_depth=3}) tax) -val md4 = rename_wfpo "md4" (TAX_Data.put ({key=9,max_depth=4}) tax) -val md5 = rename_wfpo "md5" (TAX_Data.put ({key=9,max_depth=5}) tax) -val md6 = rename_wfpo "md6" (TAX_Data.put ({key=9,max_depth=6}) tax) -val md7 = rename_wfpo "md7" (TAX_Data.put ({key=9,max_depth=7}) tax) -val md8 = rename_wfpo "md8" (TAX_Data.put ({key=9,max_depth=8}) tax) -*) - -(* -val wfs = [wfc_inf,wfc_vis] -val pos = [po_lsk,po_cm,po_sm,po_cmd,po_quy] -*) - -(* -val wfs = [wfc_rfm_SC] -val pos = [po_rfm_SC] -*) -(* -val wfs = [] -val pos = [po_cm,po_sm] -*) -(* -val wfs = [] -val pos = [po_cstr] -*) - -(* -val wfs = [wfc_vis] -val pos = [] -*) - -val wfs = [wfc_quy_strong,wfc_quy_weak] -val pos = [po_rfm_SC] - -(* +(* ALL CONSTRAINTS: val wfc = [wfc_inf_nameclashes,wfc_inf_stereotypes,wfc_inf_all,wfc_vis_class,wfc_vis_inheritance,wfc_vis_runtime,wfc_vis_design_by_contract,wfc_vis,wfc_tax] val pos = [po_lsk_pre,po_lsk_post,po_lsk_inv,po_cm,po_sm,po_om,po_cstr_post,po_cstr_attribute,po_cstr] *) + +val wfcs = [] +val pos = [po_lsk_inv] diff --git a/su4sml/src/wfcpog/test-suite.sml b/su4sml/src/wfcpog/test-suite.sml index c669a9b..06ca06e 100644 --- a/su4sml/src/wfcpog/test-suite.sml +++ b/su4sml/src/wfcpog/test-suite.sml @@ -12,16 +12,11 @@ sig val runTests_ret_pos : WFCPOG.wfpo list -> WFCPOG.wfpo list -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list (** Exectures a specified (string fst arg) test and returns the, if any, pos.*) val runTest_ret_pos : string -> WFCPOG.wfpo list -> WFCPOG.wfpo list -> (Rep_OclType.Path * Rep_OclTerm.OclTerm) list - (** Set Control.Print.printDepth. *) - val spd : int -> unit - (** Set Control.Print.printLength. *) - val spl : int -> unit exception WFCPOG_TestSuiteError of string end structure WFCPOG_TestSuite : WFCPOG_TESTSUITE = struct - open Rep_Logger open Rep_OclTerm open Rep_OclType @@ -30,6 +25,7 @@ open WFCPOG_Refine_Constraint open WFCPOG_Registry open OclLibrary + exception WFCPOG_TestSuiteError of string type testcase = @@ -127,20 +123,6 @@ val testcases = [ }:testcase ] -fun spd x = - let - val _ = Control.Print.printDepth:=x - in - print ("printDepth set to " ^ (Int.toString (x)) ^ ".\n") - end - -fun spl x = - let - val _ = Control.Print.printLength:=x - in - print ("printLength set to " ^ (Int.toString (x)) ^ ".\n") - end - fun add_dot 1 = ["."] | add_dot x = (".")::(add_dot (x-1)) diff --git a/su4sml/src/wfcpog/wfcpog.cm b/su4sml/src/wfcpog/wfcpog.cm index 70e3507..91dd982 100644 --- a/su4sml/src/wfcpog/wfcpog.cm +++ b/su4sml/src/wfcpog/wfcpog.cm @@ -72,4 +72,5 @@ Group is "SecureUML_constraint.sml" (* wccpog toplevel *) +"test-suite.sml" "wfcpog_registry.sml"