misc

git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7975 3260e6d1-4efc-4170-b0a7-36055960796d

su4sml/src/wfcpog/test-data.sml

@@ -89,12 +89,13 @@ val _ = trace high ("............. refine pog constraint loaded ...\n")
 
  
 (* 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_all,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_all]
 
 (*
-val wfcs = []
+val wfcs = [wfc_vis_class]
 val pos = [po_lsk_inv]
 *)

su4sml/src/wfcpog/test-suite.sml

@@ -71,11 +71,11 @@ val testcases = [
     uml  = prefix^"simple_rfm/simple_rfm.zargo",
     ocl  = prefix^"simple_rfm/simple_rfm.ocl"
    },
-   (*{
+   {
     name = "company",
     uml  = prefix^"company/company.zargo",
     ocl  = prefix^"company/company.ocl"
-   }:testcase,*)
+   }:testcase,
    {
     name = "ebank",
     uml  = prefix^"ebank/ebank.zargo",
@@ -91,11 +91,11 @@ val testcases = [
     uml  = prefix^"isp/isp.zargo",
     ocl  = prefix^"isp/isp.ocl"
    }:testcase,*)
-    (* {
+   {
     name = "royals_and_loyals",
     uml  = prefix^"royals_and_loyals/royals_and_loyals.zargo",
     ocl  = prefix^"royals_and_loyals/royals_and_loyals.ocl"
-   }:testcase, *) 
+   }:testcase, 
    {
     name = "simple",
     uml  = prefix^"simple/simple.zargo",
@@ -111,11 +111,11 @@ val testcases = [
     uml  = prefix^"vehicles/vehicles.zargo",
     ocl  = prefix^"vehicles/vehicles.ocl"
    }:testcase,
-   (* {
+   {
     name = "SimpleChair",
     uml  = prefix^"SimpleChair/SimpleChair.zargo",
     ocl  = prefix^"SimpleChair/ConcreteSimpleChair01.ocl"
-   }:testcase, *)
+   }:testcase,
    {
     name = "overriding",
     uml  = prefix^"overriding/overriding.zargo",
@@ -204,7 +204,7 @@ 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 model = (((#1 i_model)@oclLib),(#2 i_model))
 	val _ = trace wgen ("Model of testcase loaded ...\n")
 	val x = start_tests model (wfs@pos)
 	val _ = trace wgen ("Test finished ...\n")

su4sml/src/wfcpog/visibility_consistency.sml

@@ -173,13 +173,8 @@ fun check_entity_classifier class model =
     let
 	val vis_ops = List.map (fn (a:operation) => ((#visibility a),SOME(a),NONE,NONE)) (all_operations_of class model)
 	val vis_atts = List.map (fn (a:attribute) => ((#visibility a),NONE,SOME(a),NONE)) (all_attributes_of class model)
-        (* TODO: AssociationEnd support :
-
-                 uncaught exception Bind [nonexhaustive binding failure]
-                 raised at: ../rep_core.sml:1775.11-1775.112
-                 test-suite.sml:163.13
-	
-	val vis_assocs = List.map (fn (a:associationend) => ((#visibility a),NONE,NONE,SOME(a))) (associationends_of (#2 model) class) *)
+        val vis_assocs = List.map (fn (a:associationend) => ((#visibility a),NONE,NONE,SOME(a))) (all_associationends_of class model)
+			 handle Bind => raise WFCPOG.WFCPOG_Exception ("Bind exception\n")
 	val vis_class = visibility_of class
 	val check = 
 	    List.map (fn ((a:Visibility),x,y,z) => 

su4sml/src/wfcpog/wfcpog.sml

@@ -71,6 +71,7 @@ sig
 
   exception WFC_FailedMessage of string
   exception WFC_FailedException of (wfpo * string)
+  exception WFCPOG_Exception of string
 
 end
 
@@ -96,6 +97,7 @@ and wfpo = WFPO of {
 
 exception WFC_FailedMessage of string
 exception WFC_FailedException of (wfpo * string)
+exception WFCPOG_Exception of string
 
 fun get_data (WFPO w) = #data w
 fun up_data  data' (WFPO{identifier=identifier,name=name,description=description,