2008-12-07 20:58:07 +00:00
|
|
|
(*****************************************************************************
|
|
|
|
* su4sml --- a SML repository for managing (Secure)UML/OCL models
|
|
|
|
* http://projects.brucker.ch/su4sml/
|
|
|
|
*
|
|
|
|
* su4sml.sml ---
|
|
|
|
* This file is part of su4sml.
|
|
|
|
*
|
|
|
|
* Copyright (c) 2008 Achim D. Brucker, Germany
|
|
|
|
*
|
|
|
|
* All rights reserved.
|
|
|
|
*
|
|
|
|
* Redistribution and use in source and binary forms, with or without
|
|
|
|
* modification, are permitted provided that the following conditions are
|
|
|
|
* met:
|
|
|
|
*
|
|
|
|
* * Redistributions of source code must retain the above copyright
|
|
|
|
* notice, this list of conditions and the following disclaimer.
|
|
|
|
*
|
|
|
|
* * Redistributions in binary form must reproduce the above
|
|
|
|
* copyright notice, this list of conditions and the following
|
|
|
|
* disclaimer in the documentation and/or other materials provided
|
|
|
|
* with the distribution.
|
|
|
|
*
|
|
|
|
* * Neither the name of the copyright holders nor the names of its
|
|
|
|
* contributors may be used to endorse or promote products derived
|
|
|
|
* from this software without specific prior written permission.
|
|
|
|
*
|
|
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
******************************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
|
|
|
|
structure su4sml = struct
|
|
|
|
|
|
|
|
fun basename name = (hd o rev) (String.fields (fn s => s = #"/" orelse s = #"\\") name)
|
|
|
|
|
|
|
|
fun print_usage name = let
|
|
|
|
val _ = print ("Type '"^name^" help' for usage.\n")
|
|
|
|
in
|
|
|
|
0
|
|
|
|
end
|
|
|
|
|
|
|
|
fun print_help name = let
|
|
|
|
val _ = print("\n")
|
|
|
|
val _ = print("usage: "^name^" <subcommand> [options] [args]\n")
|
|
|
|
val _ = print("Su4sml command-line client")
|
|
|
|
val _ = print("Type '"^name^" help <subcommand>' for help on a specific subcommand.\n")
|
|
|
|
val _ = print("\n")
|
|
|
|
val _ = print("Available subcommands:\n")
|
|
|
|
val _ = print(" check-model\n")
|
|
|
|
val _ = print(" codegen\n")
|
|
|
|
val _ = print(" transform-model\n")
|
|
|
|
val _ = print(" typecheck\n")
|
|
|
|
val _ = print("\n")
|
2009-01-04 22:57:12 +00:00
|
|
|
val _ = print("Reading ArgoUML files requires the '"^Config.unzip^"' program.\n")
|
|
|
|
val _ = print("Current status: ")
|
|
|
|
val _ = print("The program '"^Config.unzip^"' was ")
|
|
|
|
val _ = print("\n")
|
2009-01-04 18:04:16 +00:00
|
|
|
val _ = print("Reading XMI or ArguUML files requires the file '"^Config.umlocl_dtd^"' which\n")
|
|
|
|
val _ = print("must be either located in the local directory or in '$SU4SML_HOME/share'.\n")
|
|
|
|
val _ = print("Current status: ")
|
|
|
|
val _ = print("SU4SML_HOME="^(Config.su4sml_home())^"\n")
|
|
|
|
val _ = if Config.check_unzip()
|
|
|
|
then print ""
|
|
|
|
else print "not"
|
|
|
|
val _ = print "found.\n"
|
|
|
|
val _ = print("\n")
|
|
|
|
val _ = if Config.check_argo_import ()
|
|
|
|
then print "Support for XMI and ArgoUML files enabled.\n"
|
|
|
|
else
|
|
|
|
if Config.check_xmi_import ()
|
|
|
|
then print "Support for XMI files enabled, support for ArgoUML files disabled.\n"
|
|
|
|
else print "Support for XMI and ArgoUML files disabled.\n"
|
|
|
|
val _ = print("\n")
|
2008-12-07 20:58:07 +00:00
|
|
|
val _ = print("Su4sml is a tool for working with UML/OCL and SecureUML/OCL models.\n")
|
|
|
|
val _ = print("For additional information, see http://projects.brucker.ch/projects/su4msl/\n")
|
|
|
|
in
|
|
|
|
0
|
|
|
|
end
|
|
|
|
|
|
|
|
|
2009-01-04 18:04:16 +00:00
|
|
|
|
2008-12-07 20:58:07 +00:00
|
|
|
structure typecheck = struct
|
|
|
|
|
|
|
|
fun print_usage() = let
|
|
|
|
val _ = print("\n")
|
|
|
|
val _ = print("typecheck: typecheck a UML/OCL specification\n")
|
|
|
|
val _ = print("usage: typeckeck UML [OCL]\n")
|
|
|
|
val _ = print("\n")
|
2008-12-30 09:00:24 +00:00
|
|
|
val _ = print("UML can be either a ArgoUML file (i.e, *.zargo), a compatible XMI file \n")
|
2008-12-07 20:58:07 +00:00
|
|
|
val _ = print("or the output of the Dresden OCL Toolkit, version 2.0. In the latter \n")
|
|
|
|
val _ = print("case, the OCL specification contained in the XMI from Dresden OCL \n")
|
|
|
|
val _ = print("is merged with the specification given in the OCL file.\n")
|
|
|
|
(* val _ = print("\n")
|
|
|
|
val _ = print("Valid options:\n") *)
|
|
|
|
in
|
|
|
|
0
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
fun check uml ocl = let
|
|
|
|
val xmi = ModelImport.parseUML uml
|
|
|
|
handle _ => ([],[])
|
|
|
|
val ocl = ModelImport.parseOCL ocl
|
|
|
|
handle _ => []
|
|
|
|
val OclParse = if ocl = [] then false else true
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Preprocess Context List ###\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
val fixed_ocl = Preprocessor.preprocess_context_list
|
|
|
|
ocl ((OclLibrary.oclLib)@(#1 xmi))
|
|
|
|
handle _ => []
|
|
|
|
val OclPreprocess = if fixed_ocl = [] then false else true
|
|
|
|
val OclPreprocess = OclPreprocess andalso OclParse
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Finished Preprocess Context List ###\n\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Type Checking ###\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
val typed_cl = TypeChecker.check_context_list
|
|
|
|
fixed_ocl (((OclLibrary.oclLib)@(#1 xmi)),#2 xmi)
|
|
|
|
handle _ => []
|
|
|
|
val OclTC = if typed_cl = [] then false else true
|
|
|
|
val OclTC = OclTC andalso OclPreprocess
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Finished Type Checking ###\n\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Updating Classifier List ###\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
val model = Update_Model.gen_updated_classifier_list
|
|
|
|
typed_cl ((OclLibrary.oclLib)@(#1 xmi))
|
|
|
|
handle _ => []
|
|
|
|
val modelUpdate = if model = [] then false else true
|
|
|
|
val modelUpdate = modelUpdate andalso OclTC
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.info "### Finished Updating Classifier List ###\n"
|
2008-12-07 20:58:07 +00:00
|
|
|
|
|
|
|
|
|
|
|
fun printBool b = if b then "passed" else "FAILED"
|
|
|
|
val _ = print ("\n *** type checking result ***\n")
|
|
|
|
val _ = print (" parsing: "^(printBool OclParse)^"\n")
|
|
|
|
val _ = print (" preprocess: "^(printBool OclPreprocess)^"\n")
|
|
|
|
val _ = print (" typecheck: "^(printBool OclTC)^"\n")
|
|
|
|
val _ = print (" update: "^(printBool modelUpdate)^"\n")
|
|
|
|
val _ = print (" ==> summary: "^(printBool modelUpdate)^"\n")
|
|
|
|
in
|
|
|
|
if modelUpdate then 0 else 1
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
fun main (name:string,args:(string list)) =
|
|
|
|
let
|
|
|
|
val prgName = (hd o rev) (String.fields (fn s => s = #"/" orelse s = #"\\") name);
|
2009-01-03 21:18:36 +00:00
|
|
|
val _ = Logger.set_log_level Logger.WARN
|
2008-12-07 20:58:07 +00:00
|
|
|
in
|
|
|
|
case (prgName,args) of
|
|
|
|
(n, []) => print_usage n
|
|
|
|
(* su4sml *)
|
|
|
|
| ("su4sml", ["help"]) => print_help "su4sml"
|
|
|
|
| ("su4sml", ["help", subcmd]) => main(subcmd,["help"])
|
|
|
|
(* check-model *)
|
|
|
|
|
|
|
|
| (_, ["check-model", "help"]) => let val _ = print "not yet supported \n" in 0 end
|
|
|
|
| (_, "check-model"::_) => let val _ = print "not yet supported \n" in 0 end
|
|
|
|
(* codegen *)
|
|
|
|
| (_, ["codegen", "help"]) => let val _ = Codegen.print_usage() in 0 end
|
2008-12-09 05:49:14 +00:00
|
|
|
| ("su4sml", "codegen"::args) => Codegen.main("su4sml",args)
|
2008-12-07 20:58:07 +00:00
|
|
|
| (_, "codegen"::_) => let val _ = Codegen.print_usage() in 0 end
|
|
|
|
(* transform-model *)
|
|
|
|
| (_, ["transform-model", "help"]) => let val _ = print "not yet supported \n" in 0 end
|
|
|
|
| (_, "transform-model"::_) => let val _ = print "not yet supported \n" in 0 end
|
|
|
|
(* typecheck *)
|
|
|
|
| (_, ["typecheck", "help"]) => typecheck.print_usage()
|
|
|
|
| (_, ["typecheck", uml]) => typecheck.check uml ""
|
|
|
|
| (_, ["typecheck", uml,ocl]) => typecheck.check uml ocl
|
|
|
|
| (_, "typecheck"::_) => typecheck.print_usage()
|
|
|
|
(* default match: *)
|
|
|
|
| (n,_) => print_usage n
|
|
|
|
end
|
|
|
|
end
|
|
|
|
|
|
|
|
val _ = su4sml.main(CommandLine.name(), CommandLine.arguments())
|