From 9d8e5283288090b0a3d4a6d9f457e0bd14aff9cd Mon Sep 17 00:00:00 2001 From: Manuel Krucker Date: Tue, 6 May 2008 11:32:06 +0000 Subject: [PATCH] new subconstraint added git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7878 3260e6d1-4efc-4170-b0a7-36055960796d --- su4sml/src/wfcpog/visibility_consistency.sml | 129 ++++++++++++++++++- 1 file changed, 122 insertions(+), 7 deletions(-) diff --git a/su4sml/src/wfcpog/visibility_consistency.sml b/su4sml/src/wfcpog/visibility_consistency.sml index f31ba61..dfa3a9a 100644 --- a/su4sml/src/wfcpog/visibility_consistency.sml +++ b/su4sml/src/wfcpog/visibility_consistency.sml @@ -43,16 +43,16 @@ signature WFCPOG_VISIBILITY_CONSTRAINT = sig val are_conditions_visible : WFCPOG.wfpo -> Rep.Model -> bool -(* + (** * Checks if the visibility of the class is at least as visible as * as the most visible member. *) - val model_class_consistency : WFCPOG.wfpo -> Rep.Model -> bool + val model_entity_consistency : WFCPOG.wfpo -> Rep.Model -> bool (** * Checks if the modificators of overriden features are maintained in the subclasses. *) - val model_inheritence_consistency : WFCPOG.wfpo -> Rep.Model -> bool + val model_inheritance_consistency : WFCPOG.wfpo -> Rep.Model -> bool (** * Runtime checking/enforcement in mind: * pre-condition, post-conditions, invariants are shall only contain @@ -61,6 +61,7 @@ sig * protected features of superclasses, and own private features). * Checks the pre-,postconditions and invariants with respect to *) +(* val constraint_check_by_runtime_consistency : WFCPOG.wfpo -> Rep.Model -> bool (** * Design by contract in mind: @@ -91,6 +92,7 @@ open WFCPOG_Library exception WFCPOG_VisibilityError of string +type Visibility = XMI_DataTypes.VisibilityKind fun modificator_conforms_to private private = true | modificator_conforms_to protected private = true @@ -248,11 +250,124 @@ fun are_conditions_visible wfpo (model:Rep.Model as (clist,alist)) = in res end + + +fun visibility2string public = "public" + | visibility2string package = "package" + | visibility2string protected = "protected" + | visibility2string private = "private" + +fun visibility_conform public _ = true + | visibility_conform package public = false + | visibility_conform package _ = true + | visibility_conform protected protected = true + | visibility_conform protected private = true + | visibility_conform protected _ = false + | visibility_conform private private = true + | visibility_conform private _ = false + +fun check_visibility_of_classifier class model = + let + val vis_ops = List.map (fn (a:operation) => ((#visibility a),[a],[],[])) (all_operations_of class model) + val vis_atts = List.map (fn (a:attribute) => ((#visibility a),[],[a],[])) (all_attributes_of class model) + val vis_assocs = List.map (fn (a:associationend) => ((#visibility a),[],[],[a])) (all_associationends_of class model) + val vis_class = visibility_of class + val _ = + List.map (fn ((a:Visibility),x,y,z) => + if (visibility_conform vis_class a) + then () + else + let + val s1 = "SYNTAX ERROR: Visibility consistency\n\n" + val s2 = "Classifier " ^ (string_of_path (name_of class)) ^ " is not visible enough.\n" + val s3 = "Visibility of classifer: " ^ (visibility2string (visibility_of class)) ^ ".\n" + val s4 = case List.length(x) of + 1 => ("Visibility of operation " ^ (name_of_op (List.hd(x))) ^ " : " ^ (visibility2string a)) + | _ => "" + val s5 = case List.length(y) of + 1 => ("Visibility of attribute " ^ (name_of_att (List.hd(y))) ^ " : " ^ (visibility2string a)) + | _ => "" + val s6 = case List.length(z) of + 1 => ("Visibility of operation " ^ (name_of_aend (List.hd(z))) ^ " : " ^ (visibility2string a)) + | _ => "" + in + raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2^s3^s4^s5^s6) + end + ) ((vis_ops)@(vis_atts)@(vis_assocs)) + in + true + end + + +fun check_inheritance_visibility_of_classifier class model = + let + (* modified operations *) + val mod_ops_this = modified_operations_of class model + (* TODO: support for + * - modified_attributes_of + * - modified_associationends_of + *) + val mod_ops_super_this = List.map (fn oper => + let + val op_name = name_of_op oper + val super_class = go_up_hierarchy class (class_has_local_op op_name model) model + val super_op = get_operation op_name super_class model + in + (super_class,super_op,oper) + end) mod_ops_this + + val _ = + List.map (fn (super,sop,this_op) => + if (visibility_conform (#visibility this_op) (#visibility sop)) + then () + else + let + val s1 = "SYNTAX ERROR: Visibility inheritance consistency\n\n" + val s2 = "Classifier " ^ (string_of_path (name_of class)) ^ " has inconsistent visibility for the overriden operation: " ^ (name_of_op this_op) ^ ".\n" + val s3 = "Visibility of the overriden operation : " ^ (visibility2string (#visibility this_op)) ^ ".\n" + val s4 = "Visibility of the original operation (located in " ^ (string_of_path (name_of super)) ^ " ) : " ^ (visibility2string (#visibility sop)) ^ ".\n" + in + raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2^s3^s4) + end + ) mod_ops_super_this + val _ = trace function_ends ("WFCPOG_Visibility_Consistency.check_inheritance_visibility_consistency\n") + in + true + end + + + +fun model_entity_consistency_help [] model = true + | model_entity_consistency_help (h::classes) model = + let + val _ = check_visibility_of_classifier h model + in + model_entity_consistency_help classes model + end + +fun model_inheritance_consistency_help [] model = true + | model_inheritance_consistency_help (h::classes) model = + let + val _ = check_inheritance_visibility_of_classifier h model + in + model_inheritance_consistency_help classes model + end + + +fun model_entity_consistency wfc_sel (model as (clist,alist)) = + let + val classes = removeOclLibrary (clist) + in + model_entity_consistency_help classes model + end + +fun model_inheritance_consistency wfc_sel (model as (clist,alist)) = + let + val classes = removeOclLibrary (clist) + in + model_inheritance_consistency_help classes model + end (* -fun model_class_consistency - -fun model_inheritance_consistency - fun constraint_check_by_runtime_consistency fun constratin_design_by_constract_consistency