From 6adf41cd4b1fa630af947adeb6ba7a41a8c2d4a9 Mon Sep 17 00:00:00 2001 From: Manuel Krucker Date: Wed, 7 May 2008 14:42:03 +0000 Subject: [PATCH] cleaned up taxonomy consistency git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@7901 3260e6d1-4efc-4170-b0a7-36055960796d --- su4sml/src/wfcpog/taxonomy_consistency.sml | 37 +++++++++++++--------- su4sml/src/wfcpog/test-data.sml | 2 +- su4sml/src/wfcpog/wfcpog_registry.sml | 4 +-- 3 files changed, 25 insertions(+), 18 deletions(-) diff --git a/su4sml/src/wfcpog/taxonomy_consistency.sml b/su4sml/src/wfcpog/taxonomy_consistency.sml index 76a58c3..1c139c0 100644 --- a/su4sml/src/wfcpog/taxonomy_consistency.sml +++ b/su4sml/src/wfcpog/taxonomy_consistency.sml @@ -54,7 +54,7 @@ sig val print_taxonomy_args : TAX_args -> unit (** Subconstraint *) - val has_maxDepth : WFCPOG.wfpo -> Rep.Model -> bool + val check_depth : WFCPOG.wfpo -> Rep.Model -> bool exception WFCPOG_TaxonomyError of string end @@ -118,28 +118,35 @@ fun deep_of_classifier x (Class{parent,...}) (model as (clist,alist)) = | deep_of_classifier x y model = raise WFCPOG_TaxonomyError ("Only Classes can check for maxDepth.\n") -fun has_maxDepth_help depth [] model = true - | has_maxDepth_help depth (h::classes) (model as (clist,alist)) = + +fun check_depth_classifier depth class (model as (clist,alist)) = let val _ = trace wgen ("look for deep ...\n") - val d = deep_of_classifier 0 h model - val _ = trace wgen ("deep of classifier " ^ (String.concat (Rep_Core.name_of h)) ^ " = " ^ (Int.toString d) ^ "\n") + val d = deep_of_classifier 0 class model + val check = + if (depth > d) + then true + else + let + val s1 = "SYNTAX ERROR: Taxonomy design consistency\n\n" + val s2 = "Classifier " ^ (string_of_path (name_of class)) ^ " has depth " ^ (Int.toString (d)) ^ ".\n" + in + raise WFCPOG.WFCPOG_WFC_FailedException (s1^s2) + end in - if (d > depth) - then false - else has_maxDepth_help depth classes model + check end -fun has_maxDepth wfpo (model as (clist,alist)) = +fun check_depth wfpo (model as (clist,alist)) = let - val _ = trace wgen ("remove oclLib ...\n") - val classes = removeOclLibrary clist - val _ = trace wgen ("oclLib removed ...\n") + val _ = trace function_calls ("WFCPG_Taxonomy_Consistency.check_maxDepth\n") + val cl = removeOclLibrary clist + val classes = List.filter (fn a => (is_Class a) orelse (is_AssoClass a) orelse (is_Iface a) orelse (is_Enum a) orelse (is_Primi a)) cl val tax_args = WFCPOG_TAX_Data.get wfpo - val _ = trace wgen ("args extracted ...\n") val depth = (#max_depth tax_args) - val _ = trace wgen ("depth = " ^ (Int.toString (depth)) ^ "\n") + val res = List.all (fn a => a = true) (List.map (fn a => check_depth_classifier depth a model) classes) + val _ = trace function_calls ("WFCPG_Taxonomy_Consistency.check_maxDepth\n") in - has_maxDepth_help depth classes model + res end end; diff --git a/su4sml/src/wfcpog/test-data.sml b/su4sml/src/wfcpog/test-data.sml index 582407e..81db050 100644 --- a/su4sml/src/wfcpog/test-data.sml +++ b/su4sml/src/wfcpog/test-data.sml @@ -120,5 +120,5 @@ val pos = [po_cstr] val wfs = [wfc_vis] val pos = [] *) -val wfs = [wfc_vis_class,wfc_vis_inheritance,wfc_vis_runtime,wfc_vis_design_by_contract,wfc_vis] +val wfs = [wfc_vis_class] val pos = [] diff --git a/su4sml/src/wfcpog/wfcpog_registry.sml b/su4sml/src/wfcpog/wfcpog_registry.sml index e7452d0..2d40d74 100644 --- a/su4sml/src/wfcpog/wfcpog_registry.sml +++ b/su4sml/src/wfcpog/wfcpog_registry.sml @@ -162,7 +162,7 @@ val tax_workaround = recommended = true, depends = [], recommends = [], - apply = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.has_maxDepth), + apply = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.check_depth), data = Datatab.empty } @@ -259,7 +259,7 @@ val supported_wfs = [ recommended = true, depends = [], recommends = [], - apply = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.has_maxDepth), + apply = WFCPOG.WFC(WFCPOG_Taxonomy_Constraint.check_depth), data = Datatab.empty } ,