HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

changed some error messages 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@5979 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2007-01-29 16:14:56 +00:00
parent 5d9dc9bfd5
commit 588d1c50a9
15 changed files with 117 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/smlnj.sml
View File

@ -46,7 +46,7 @@ fun eval verbose txt =
if verbose then print (output ()) else ()
end
in
eval_fh (fn s => print (s^"\n"), fn s => library.error_ ((s^"\n"),library.ERROR)) verbose txt
eval_fh (fn s => print (s^"\n"), fn s => library.error s) verbose txt
end
fun exnHistory e = SMLofNJ.exnHistory e

100
src/component_uml.sml
View File

@ -56,30 +56,26 @@ val root_stereotypes = ["compuml.entity"]
(** The list of all attributes of an entity. *)
fun entity_contained_attributes (Entity c) = map EntityAttribute (Rep.attributes_of c)
| entity_contained_attributes _ = library.error' "entity_contained_attributes \
\called on something that is \
\not an entity"
| entity_contained_attributes _ = library.error "in entity_contained_attributes: \
\argument is not an entity"
(** the list of all methods of an entity *)
fun entity_contained_methods (Entity c) = map EntityMethod (Rep.operations_of c)
| entity_contained_methods _ = library.error' "entity_contained_methods \
\called on something that is \
\not an entity"
| entity_contained_methods _ = library.error "in entity_contained_methods: \
\argument is not an entity"
(** The list of all side-effect free methods of an entity. *)
fun entity_contained_read_methods (Entity c) =
map EntityMethod (List.filter #isQuery (Rep.operations_of c))
| entity_contained_read_methods _ = library.error' "entity_contained_read_methods \
\called on something that is \
\not an entity"
| entity_contained_read_methods _ = library.error "in entity_contained_read_methods: \
\argument is not an entity"
(** The list of all methods with side-effects of an entity *)
fun entity_contained_update_methods (Entity c) =
map EntityMethod (List.filter (not o #isQuery) (Rep.operations_of c))
| entity_contained_update_methods _ = library.error'
"entity_contained_update_methods \
\called on something that is not \
\an entity"
| entity_contained_update_methods _ = library.error
"in entity_contained_update_methods: \
\argument is not an entity"
(** The resources that are contained in the given resource. *)
fun contained_resources x =
@ -101,62 +97,65 @@ fun parse_entity_action root att_name "create" =
SimpleAction ("delete", (Entity root))
| parse_entity_action root att_name "fullaccess" =
CompositeAction ("fullaccess", (Entity root))
| parse_entity_action root att_name s = library.error' ("unknown action type "^s^
" for entity action")
| parse_entity_action root att_name s = library.error ("in parse_entity_action: \
\unknown action type "^s)
(** parses an entity attribute action permission attribute. *)
fun parse_attribute_action root name "read" =
(SimpleAction ("read",
(SimpleAction ("read",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
handle Empty => library.error' "did not find attribute")
(Rep.attributes_of root))))
handle Empty => library.error ("in parse_attribute_action: \
\did not find attribute "^name))
| parse_attribute_action root name "update" =
( SimpleAction ("update",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
handle Empty => library.error' "did not find attribute")
handle Empty => library.error ("in parse_attribute_action: \
\did not find attribute "^name))
| parse_attribute_action root name "fullaccess" =
( CompositeAction ("fullaccess",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
handle Empty => library.error' "did not find attribute")
| parse_attribute_action root name s = library.error' ("unknown action type "^s^
"for attribute action")
handle Empty => library.error ("in parse_attribute_action: \
\did not find attribute "^name))
| parse_attribute_action root name s = library.error ("in parse_attribute_action: \
\unknown action type "^s^
"for attribute action "^name)
(** parses an entity method action permission attribute. *)
fun parse_method_action root name "execute"
= (SimpleAction ("execute",
(EntityMethod ((hd o List.filter (fn x => #name x = name))
(Rep.operations_of root))))
handle Empty => library.error' "did not find method")
| parse_method_action roor name s = library.error' ("unknown action type "^s^
"for method action")
handle Empty => library.error ("in parse_method_action: did not find method "^name))
| parse_method_action roor name s = library.error ("unknown action type "^s^
"for method action "^name)
(**
* parses a permission attribute according to the ComponentUML
* dialect for SecureUML.
*)
fun parse_action root (att:Rep.attribute) =
let val att_name = #name att
val att_type = #attr_type att
let val att_name = #name att
val att_type = #attr_type att
val cls_path = case att_type of Rep_OclType.Classifier x => x
| _ => library.error' "permission attribute \
\type is not a classifier"
val action_name = hd (rev cls_path)
| _ => library.error "type of permission attribute \
\is not a classifier"
val action_name = hd (rev cls_path)
fun resource_path name = (hd o List.tl) (String.tokens (fn x => x= #".") name)
in case hd (#stereotypes att)
of "dialect.entityaction" =>
in case hd (#stereotypes att)
of "dialect.entityaction" =>
parse_entity_action root att_name action_name
| "dialect.entitymethodaction" =>
| "dialect.entitymethodaction" =>
parse_method_action root (resource_path att_name) action_name
| "dialect.entityattributeaction" =>
| "dialect.entityattributeaction" =>
parse_attribute_action root (resource_path att_name) action_name
| s => library.error' ("in ComponentUML.parse_action: "^
"found unexpected stereotype "^s^
" for permission attribute")
end
handle _ => library.error' "in ComponentUML.parse_action: \
\could not parse attribute"
| s => library.error ("in ComponentUML.parse_action: "^
"permission attribute "^att_name^"has unexpected stereotype "^s)
end
handle ex => (library.error_msg "in ComponentUML.parse_action: \
\could not parse permission attribute"; raise ex)
fun action_type_of (SimpleAction (t,_)) = t
| action_type_of (CompositeAction (t,_)) = t
@ -165,15 +164,15 @@ fun action_type_of (SimpleAction (t,_)) = t
(** The actions possible on the given resource. *)
fun actions_of (e as (Entity c)) = [SimpleAction ("create", e),
CompositeAction ("read", e),
CompositeAction ("update", e),
SimpleAction ("delete", e),
CompositeAction ("full_access",e)]
CompositeAction ("read", e),
CompositeAction ("update", e),
SimpleAction ("delete", e),
CompositeAction ("full_access",e)]
| actions_of (m as (EntityMethod p)) = [SimpleAction ("execute", m)]
| actions_of (a as (EntityAttribute p)) = [SimpleAction ("read", a),
SimpleAction ("update", a),
CompositeAction ("full_access", a)]
SimpleAction ("update", a),
CompositeAction ("full_access", a)]
(** The resource an action acts on. *)
fun resource_of (SimpleAction x) = #2 x
| resource_of (CompositeAction x) = #2 x
@ -204,8 +203,7 @@ fun subordinated_actions (SimpleAction _) = nil
| subordinated_actions (CompositeAction ("full_access", a as (EntityAttribute ae)))
= [SimpleAction ("read", a),
SimpleAction ("update", a)]
| subordinated_actions (CompositeAction _) = library.error' "encountered unknown \
\composite action \
\type in \
\subordinated_actions"
| subordinated_actions (CompositeAction (s,_)) = library.error ("in subordinated_actions: \
\unsupported composite action \
\type "^s)
end

14
src/library.sml
View File

@ -98,11 +98,19 @@ exception ERROR;
(* val writeln = std_output o suffix "\n";*)
(* fun error_msg s = writeln(s) *)
(** output an informational message about what is going on. *)
fun info s = print (s^"\n")
(** output a warning that something is wrong,
* but it is dealt with somehow. *)
fun warn s = print (s^"\n")
fun error_ (s,ex) = (print (s^"\n"); raise ex)
fun error' s = error_ (s,Fail s)
fun error s = print (s^"\n")
(** output an error message *)
fun error_msg s = print (s^"\n")
(** output an error message and Fail *)
fun error s = (print (s^"\n"); raise Fail s)
fun fst (x, y) = x

4
src/ocl2string.sml
View File

@ -181,7 +181,7 @@ fun ocl2string show_types oclterm =
(* Iterate *)
(**************************************)
(* Error *)
| Iterate (_,s,_,_,src,_,c,_,_) => error' ("error: unknown Iterate '"^(s)^"' in in ocl2string")
| Iterate (_,s,_,_,src,_,c,_,_) => error ("error: unknown Iterate '"^(s)^"' in in ocl2string")
(**************************************)
(* Iterator *)
(**************************************)
@ -209,7 +209,7 @@ fun ocl2string show_types oclterm =
(* Catch out *)
(**************************************)
(* Error *)
| _ => error' "error: unknown OCL-term in in ocl2string"
| _ => error "error: unknown OCL-term in in ocl2string"
end
end

10
src/rep_core.sml
View File

@ -139,6 +139,7 @@ end
structure Rep_Core : REP_CORE =
struct
open library
open Rep_OclType
type Visibility = XMI_DataTypes.VisibilityKind
type Scope = XMI_DataTypes.ScopeKind
@ -306,14 +307,6 @@ fun assoc_to_inv cls_name (aend:associationend) =
end
fun path_of_OclType (Rep_OclType.Classifier p) = p
| path_of_OclType Rep_OclType.Integer = ["oclLib","Integer"]
| path_of_OclType Rep_OclType.Real = ["oclLib","Real"]
| path_of_OclType Rep_OclType.String = ["oclLib","String"]
| path_of_OclType Rep_OclType.Boolean = ["oclLib","Boolean"]
| path_of_OclType Rep_OclType.OclAny = ["oclLib","OclAny"]
| path_of_OclType Rep_OclType.OclVoid = ["oclLib","OclVoid"]
| path_of_OclType Rep_OclType.DummyT = ["oclLib","OclDummy"]
@ -443,7 +436,6 @@ fun type_of (Class{name,...}) = name
| type_of (Primitive{name,...}) = name
| type_of (Template{classifier,...}) = type_of classifier
fun error s = library.error' s
fun name_of (Class{name,...}) = path_of_OclType name
| name_of (Interface{name,...}) = path_of_OclType name

8
src/rep_ocl.sml
View File

@ -33,6 +33,8 @@ sig
| OrderedSet of OclType | Bag of OclType
| Collection of OclType
| Classifier of Path | OclVoid | DummyT | TemplateParameter of string
val path_of_OclType : OclType -> Path
val string_of_OclType : OclType -> string
val string_of_path : Path -> string
val pathstring_of_path: Path -> string
@ -100,6 +102,7 @@ datatype OclType = Integer | Real | String | Boolean | OclAny
| Classifier of Path
| TemplateParameter of string
(** Convert Path to a string using given separator *)
fun path_to_string (path:Path) separator = case path of
[] => ""
@ -125,6 +128,11 @@ fun string_of_OclType Integer = "Integer"
| string_of_OclType (Classifier p) = (string_of_path p)
| string_of_OclType DummyT = "DummyT"
fun path_of_OclType (Classifier p) = p
| path_of_OclType (TemplateParameter p) = [] (* FIXME *)
| path_of_OclType x = ["oclLib",string_of_OclType x]
fun is_Classifier (Classifier p) = true
| is_Classifier _ = false

8
src/rep_parser.sml
View File

@ -113,8 +113,7 @@ fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) =
* cases where this hack has unwanted consequences.
*)
val classifier_type = find_type source
val path_of_classifier = (fn (Rep_OclType.Classifier p) => p
| x => error' (Rep_OclType.string_of_OclType x)) classifier_type
val path_of_classifier = Rep_OclType.path_of_OclType classifier_type
val aend = find_associationend t referredAssociationEnd
val aend_name = Option.getOpt(#name aend,
(lowercase o XMI.classifier_name_of o
@ -288,7 +287,7 @@ fun transform_state t (XMI.CompositeState {xmiid,outgoing,incoming,subvertex,
outgoing = outgoing,
incoming = incoming,
kind = kind }
| transform_state t _ = library.error_ ("in transform_state: Subactivity states, object flow states and sync states are not supported.",library.ERROR)
| transform_state t _ = raise Fail ("in transform_state: unsupported StateVertex type (Subactivity states, object flow states and sync states are not supported).")
(* a primitive hack: we take the body of the guard g as the name of an *)
(* operation to be called in order to check whether the guard is true *)
fun transform_guard t (XMI.mk_Guard g) =
@ -432,7 +431,7 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
thyname = NONE
}
end
| transform_classifier t (_) = raise IllFormed "Not supported Classifier type found."
| transform_classifier t (_) = raise Fail "Not supported Classifier type found."
(** recursively transform all classes in the package. *)
@ -511,5 +510,6 @@ fun printStackTrace e =
*)
fun test (_,filename::_) = (Rep2String.printList (readFile filename); OS.Process.success)
handle ex => (printStackTrace ex; OS.Process.failure)
end

29
src/secure_uml.sml
View File

@ -140,12 +140,11 @@ fun filter_role cs = List.filter (classifier_has_stereotype "secuml.role") cs
fun mkRole (C as Rep.Class c) = Rep.string_of_path (Rep.name_of C)
| mkRole _ = library.error_ ("mkRole called on something that is \
\not a class",library.ERROR)
| mkRole _ = library.error ("in mkRole: argument is not a class")
(* FIXME: handle groups also *)
fun mkSubject (C as Rep.Class c) = User (Rep.string_of_path (Rep.name_of C))
| mkSubject _ = library.error_ ("mkSubject called on something that is not a class",library.ERROR)
| mkSubject _ = library.error ("in mkSubject: argument is not a class")
fun mkPermission cs (C as Rep.Class c) =
let val atts = Rep.attributes_of (Rep.Class c)
@ -160,27 +159,27 @@ fun mkPermission cs (C as Rep.Class c) =
Design.root_stereotypes)
classifiers
val root_resource = hd root_classes
handle Empty => library.error_ (("no root resource found for permission "^
Rep.string_of_path (Rep.name_of C)),library.ERROR)
handle Empty => library.error ("in mkPermission: no root resource found "^
"for permission "^Rep.string_of_path (Rep.name_of C))
val action_attributes =
List.filter (fn x => List.exists
(fn y => List.exists
(fn z => y= z)
(#stereotypes x))
Design.action_stereotypes) atts
handle _ => library.error_ ("could not parse permission attributes",library.ERROR)
handle ex => (library.error_msg "could not parse permission attributes"; raise ex)
in
{ name = (Rep.string_of_path (Rep.name_of C)),
roles = (map (Rep.string_of_path o Rep.name_of) role_classes),
(* FIXME: find attached constraints *)
constraints = nil,
actions = if action_attributes = []
then library.error_ (("no action attributes found in permission "^
(Rep.string_of_path (Rep.name_of C))),library.ERROR)
then library.error ("in mkPermission: Permission "^
(Rep.string_of_path (Rep.name_of C))^
"has no action attributes")
else map (Design.parse_action root_resource) action_attributes }
end
| mkPermission _ _ = library.error_ ("mkPermission called on something \
\that is not a class",library.ERROR)
| mkPermission _ _ = library.error "in mkPermission: argument is not a class"
(** parse a list of classifiers accoriding to the SecureUML profile.
@ -195,13 +194,15 @@ fun parse (cs:Rep_Core.Classifier list) =
{ config_type = "SecureUML",
permissions = map (mkPermission cs) (filter_permission cs),
subjects = map mkSubject (filter_subject cs),
roles = map mkRole (filter_role cs),
roles = map mkRole (filter_role cs),
rh = map (fn x => (Rep.string_of_path (Rep.name_of x),
Rep.string_of_path (Rep.parent_name_of x)))
(List.filter classifier_has_parent (filter_role cs)),
Rep.string_of_path (Rep.parent_name_of x)))
(List.filter classifier_has_parent (filter_role cs)),
(* FIXME: find associations between Users and Roles. *)
sa = nil})
handle _ => library.error_ ("Problem during parsing security configuration",library.ERROR)
handle ex => (library.error_msg "in SecureUML.parse: security configuration \
\could not be parsed";
raise ex)
end

3
src/xmi_core.sml
View File

@ -380,7 +380,8 @@ fun classifier_elementtype_of (Collection{elementtype,...}) = elementtype
| classifier_elementtype_of (Set{elementtype,...}) = elementtype
| classifier_elementtype_of (Bag{elementtype,...}) = elementtype
| classifier_elementtype_of (OrderedSet{elementtype,...}) = elementtype
| classifier_elementtype_of _ = raise IllFormed "classifier_elementtype_of called on a non-collection value"
| classifier_elementtype_of _ = library.error "in classifier_elementtype_of: \
\argument is not a collection value"
end

10
src/xmi_idtable.sml
View File

@ -374,7 +374,8 @@ fun class_taggedvalues_of table (XMI.Class c) =
| class_taggedvalues_of table (XMI.AssociationClass c) =
map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x))
(#taggedValue c)
| class_taggedvalues_of table _ = raise IllFormed "class_taggedvalues_of called on an argument that doesn't support tagged values yet..."
| class_taggedvalues_of table _ = raise IllFormed "in class_taggedvalues_of: \
\argument doesn't support tagged values"
(* returns the value of the given tag *)
@ -384,7 +385,8 @@ fun class_taggedvalue_of table tag (XMI.Class c) =
| class_taggedvalue_of table tag (XMI.AssociationClass c) =
Option.map #2 ((List.find (fn (x,y) => x=tag))
(class_taggedvalues_of table (XMI.AssociationClass c)))
| class_taggedvalue_of table tag _ = raise IllFormed "class_taggedvalues_of called on an argument that doesn't support tagged values yet..."
| class_taggedvalue_of table tag _ = raise IllFormed "in class_taggedvalues_of: \
\argument doesn't support tagged values"
(* returns a list of tag-value pairs *)
@ -486,7 +488,9 @@ fun transform_associationclass_as_association t (XMI.AssociationClass assoc) =
List.app (fn x => add_aend_to_type (#xmiid assoc, x)) aends
end
| transform_associationclass_as_association t _ = library.error_ ("in transform_associationclass_as_association: can only be called on association classes",library.ERROR)
| transform_associationclass_as_association t _ =
library.error ("in transform_associationclass_as_association: "^
"argument is not an association classes")
(* recursively transforms all associations in the package p. *)
fun transform_associations t (XMI.Package p) =

2
src/xmi_ocl.sml
View File

@ -113,7 +113,7 @@ fun expression_source_of (AssociationEndCallExp{source,...}) = source
| expression_source_of (OperationWithTypeArgExp{source,...}) = source
| expression_source_of (IterateExp{source,...}) = source
| expression_source_of (IteratorExp{source,...}) = source
| expression_source_of _ = library.error' "expression has no source"
| expression_source_of _ = library.error "expression has no source"
(* from UML 1.5 Core: --------------------------------------------------------
* A constraint is a semantic condition or restriction expressed in text.

2
src/xmi_parser.sml
View File

@ -1045,7 +1045,7 @@ fun findXmiContent tree = valOf (dfs "XMI.content" tree)
handle Option => raise IllFormed "no XMI.content found"
fun readFile f = (mkXmiContent o findXmiContent o XmlTreeParser.readFile) f
handle ex => (error ("Error during parsing of "^f^": \n\t"^General.exnMessage ex);
handle ex => (error_msg ("Error during parsing of "^f^": \n\t"^General.exnMessage ex);
raise ex)
end

10
src/xmi_state_machines.sml
View File

@ -186,7 +186,7 @@ and StateMachine = mk_StateMachine of
transitions : Transition list}
fun state_type_of (ObjectFlowState{type_,...}) = type_
| state_type_of _ = raise IllFormed "state_type_of called on a non-ObjectFlow state"
| state_type_of _ = library.error "in state_type_of: argument is not an ObjectFlow state"
fun state_entry_of (CompositeState{entry,...}) = entry
| state_entry_of (SubactivityState{entry,...}) = entry
@ -194,7 +194,7 @@ fun state_entry_of (CompositeState{entry,...}) = entry
| state_entry_of (ActionState{entry,...}) = entry
| state_entry_of (ObjectFlowState{entry,...}) = entry
| state_entry_of (FinalState{entry,...}) = entry
| state_entry_of _ = raise IllFormed "state_entry_of called on a state that does not have entry actions"
| state_entry_of _ = library.error "in state_entry_of: argument does not have entry actions"
fun state_xmiid_of (CompositeState{xmiid,...}) = xmiid
| state_xmiid_of (SubactivityState{xmiid,...}) = xmiid
@ -216,7 +216,8 @@ fun state_name_of (CompositeState{name,...}) = name
fun state_subvertices_of (CompositeState{subvertex,...}) = subvertex
| state_subvertices_of (SubactivityState{subvertex,...}) = subvertex
| state_subvertices_of _ = raise IllFormed "state_subvertices_of called on a non-composite state"
| state_subvertices_of _ = library.error "in state_subvertices_of: argument is \
\not a composite state"
fun state_outgoing_trans_of (CompositeState{outgoing,...}) = outgoing
| state_outgoing_trans_of (SubactivityState{outgoing,...}) = outgoing
@ -225,7 +226,8 @@ fun state_outgoing_trans_of (CompositeState{outgoing,...}) = outgoing
| state_outgoing_trans_of (ObjectFlowState{outgoing,...}) = outgoing
| state_outgoing_trans_of (PseudoState{outgoing,...}) = outgoing
| state_outgoing_trans_of (SyncState{outgoing,...}) = outgoing
| state_outgoing_trans_of (FinalState _) = library.error' "state_outgoing_trans_of called on a final state"
| state_outgoing_trans_of (FinalState _) = library.error "in state_outgoing_trans_of: \
\argument is a final state"
fun state_incoming_trans_of (CompositeState{incoming,...}) = incoming
| state_incoming_trans_of (SubactivityState{incoming,...}) = incoming

10
src/xmltree.sml
View File

@ -60,19 +60,19 @@ val filter_text = List.filter (fn Text x => true
| _ => false)
fun text (Text s) = s
| text _ = raise IllFormed "text called on Node element"
| text _ = raise IllFormed "in XmlTree.text: argument is a Node element"
fun attributes (Node ((elem,atts),trees)) = atts
| attributes _ = raise IllFormed "attributes_of called on a Text-Node"
| attributes _ = raise IllFormed "in attributes_of: argument is a Text-Node"
fun children (Node ((elem,atts),trees)) = trees
| children _ = raise IllFormed "children called on a Text-Node"
| children _ = raise IllFormed "in XmlTree.children: argument is a Text-Node"
fun node_children (Node ((elem,atts),trees)) = filter_nodes trees
| node_children _ = raise IllFormed "node_children called on a Text-Node"
| node_children _ = raise IllFormed "in XmlTree.node_children: argument is a Text-Node"
fun text_children (Node ((elem,atts),trees)) = filter_text trees
| text_children _ = raise IllFormed "node_children called on a Text-Node"
| text_children _ = raise IllFormed "in XmlTree.text_children: argument is a Text-Node"
fun tagname (Node ((elem,atts),trees)) = elem
| tagname (Text _) = ""

8
src/xmltree_parser.sml
View File

@ -47,8 +47,8 @@ fun readFile filename =
(Parser.parseDocument
(SOME (Uri.String2Uri ("file:UML15OCL.xmi")))
(SOME dtd) (dtd,nil,nil)
handle ex => (error ("Error while reading file UML15OCL.xmi: "^
General.exnMessage ex);
handle ex => (error_msg ("Error while reading file UML15OCL.xmi: "^
General.exnMessage ex);
raise ex));
OS.FileSys.chDir currentDir )
@ -64,8 +64,8 @@ fun readFile filename =
(SOME (Uri.String2Uri filename))
(SOME dtd) (dtd,nil,nil)
end
handle ex => (error ("Error while reading file " ^filename^": "^
General.exnMessage ex);
handle ex => (error_msg ("Error while reading file " ^filename^": "^
General.exnMessage ex);
raise ex)
val dtd = Dtd.initDtdTables()