merged final version of Manfred's semester thesis
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6239 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
116ba4d901
commit
4bd8124d03
|
|
@ -45,6 +45,7 @@ use "componentuml_cartridge.sml";
|
|||
|
||||
use "java_cartridge.sml";
|
||||
use "junit_cartridge.sml";
|
||||
use "maven_pom_cartridge.sml";
|
||||
|
||||
|
||||
(* Statemachines *)
|
||||
|
|
|
|||
|
|
@ -23,5 +23,6 @@ Group is
|
|||
c#sm_cartridge.sml
|
||||
java_cartridge.sml
|
||||
junit_cartridge.sml
|
||||
maven_pom_cartridge.sml
|
||||
gcg_core.sml
|
||||
codegen.sml
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@ in
|
|||
"c#sm_cartridge.sml"
|
||||
java_cartridge.sml
|
||||
junit_cartridge.sml
|
||||
maven_pom_cartridge.sml
|
||||
secureuml_cartridge.sig
|
||||
secureuml_cartridge.sml
|
||||
design_cartridge.sig
|
||||
|
|
|
|||
|
|
@ -54,11 +54,12 @@ structure Java_Ocl_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge))
|
|||
|
||||
structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
|
||||
|
||||
structure Maven_POM_Gcg = GCG_Core (Maven_POM_Cartridge(Base_Cartridge))
|
||||
|
||||
(*
|
||||
structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge)));
|
||||
*)
|
||||
|
||||
|
||||
(* maybe this should also hav a "description" field? *)
|
||||
type cartridge = {lang : string, (* identifier (for input) *)
|
||||
name : string, (* short description (for output) *)
|
||||
|
|
|
|||
|
|
@ -70,11 +70,19 @@ fun super2Native "ClassifierScope" = "static"
|
|||
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
|
||||
then (super2Native (String.substring(s,9,size s -10)))^"[]"
|
||||
else if ((String.extract (s,0,SOME 3)) = "Set")
|
||||
then "System.Collections.Generic.List<"
|
||||
then "java.util.List<"
|
||||
^(super2Native (String.substring(s,4,size s - 5)))^">"
|
||||
else s )
|
||||
handle Subscript => s
|
||||
|
||||
(* Get a stub for the return value of an operation - eg. null for objects *)
|
||||
fun rvstub operation = case (Rep.result_of_op operation) of
|
||||
Integer => "0"
|
||||
| Real => "0"
|
||||
| String => "\"\""
|
||||
| Boolean => "false"
|
||||
| _ => "null"
|
||||
|
||||
(* lookup environment -> string -> string
|
||||
* overrides some lookup entries of the base cartridge
|
||||
*)
|
||||
|
|
@ -90,9 +98,10 @@ fun lookup (env : environment) "attribute_name_small_letter"
|
|||
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
|
||||
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
|
||||
| lookup (env : environment) (s as "parent_interface") = List.last (Option.valOf (#curParent env))
|
||||
| lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "this" (curOperation' env)
|
||||
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "this" (curOperation' env)
|
||||
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "this" (curClassifier' env)
|
||||
| lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "this" (curOperation' env) "OclException"
|
||||
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "this" (curOperation' env) "OclException"
|
||||
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "this" (curClassifier' env) "OclException"
|
||||
| lookup (env : environment) (s as "returnvalue_stub") = rvstub (curOperation' env)
|
||||
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -52,9 +52,9 @@ fun curOperation' env = Option.valOf(curOperation env)
|
|||
|
||||
|
||||
(* any special variables? *)
|
||||
fun lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "testObject" (curOperation' env)
|
||||
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "testObject" (curOperation' env)
|
||||
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "testObject" (curClassifier' env)
|
||||
fun lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "testObject" (curOperation' env) "PreconditionFailedException"
|
||||
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "testObject" (curOperation' env) "PostconditionFailedException"
|
||||
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "testObject" (curClassifier' env) "InvariantFailedException"
|
||||
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
|
||||
|
||||
(* any special predicates?*)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,56 @@
|
|||
(*****************************************************************************
|
||||
* su4sml - a SecureUML repository for SML
|
||||
*
|
||||
* maven_pom_cartridge.sml - a maven POM cartridge for gcg
|
||||
* Copyright (C) 2007 Manfred Stock
|
||||
*
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* su4sml is free software; you can redistribute it and/or modify it under
|
||||
* the terms of the GNU General Public License as published by the Free
|
||||
* Software Foundation; either version 2 of the License, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
||||
* details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License along
|
||||
* with this program; if not, write to the Free Software Foundation, Inc.,
|
||||
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
******************************************************************************)
|
||||
|
||||
|
||||
functor Maven_POM_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE =
|
||||
struct
|
||||
|
||||
type Model = SuperCart.Model
|
||||
|
||||
type environment = { extension : SuperCart.environment }
|
||||
|
||||
fun initEnv model = { extension = SuperCart.initEnv model } : environment
|
||||
fun unpack (env : environment) = #extension env
|
||||
fun pack superEnv = {extension = superEnv} : environment
|
||||
|
||||
(* for BASE_CARTRIDGE *)
|
||||
fun curClassifier env = SuperCart.curClassifier (unpack env)
|
||||
fun curArgument env = SuperCart.curArgument (unpack env)
|
||||
fun curOperation env = SuperCart.curOperation (unpack env)
|
||||
fun curAttribute env = SuperCart.curAttribute (unpack env)
|
||||
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
|
||||
|
||||
fun curClassifier' env = Option.valOf(curClassifier env)
|
||||
fun curOperation' env = Option.valOf(curOperation env)
|
||||
|
||||
|
||||
(* any special variables? *)
|
||||
fun lookup (env : environment) s = SuperCart.lookup (unpack env) s
|
||||
|
||||
(* any special predicates?*)
|
||||
fun test (env : environment) s = SuperCart.test (unpack env) s
|
||||
|
||||
(* any special lists? *)
|
||||
fun foreach listType (env : environment) = map pack (SuperCart.foreach listType (unpack env))
|
||||
|
||||
end
|
||||
|
|
@ -1,5 +1,4 @@
|
|||
@// Example template for Java
|
||||
@// assumption: all classifiers are classes
|
||||
@// Simple template for Java
|
||||
|
||||
@foreach nonprimitive_classifier_list
|
||||
@openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java
|
||||
|
|
@ -16,14 +15,14 @@
|
|||
@end
|
||||
@if notInterface
|
||||
@if hasParent
|
||||
@tab extends $classifier_parent$
|
||||
@spcextends $classifier_parent$
|
||||
@end
|
||||
@end
|
||||
@if hasParentInterfaces
|
||||
@if isInterface
|
||||
@tab extends
|
||||
@spcextends
|
||||
@else
|
||||
@tab implements
|
||||
@spcimplements
|
||||
@end
|
||||
@foreach parent_interface_list
|
||||
@if last_interface
|
||||
|
|
@ -33,27 +32,32 @@
|
|||
@end
|
||||
@end
|
||||
@end
|
||||
{
|
||||
@spc{
|
||||
@if notInterface
|
||||
@foreach attribute_list
|
||||
@nl @tab $attribute_visibility$ $attribute_type$ $attribute_name$ ;
|
||||
@nl@tab$attribute_visibility$ $attribute_type$ $attribute_name$;
|
||||
@end
|
||||
@nl
|
||||
@end
|
||||
@foreach operation_list
|
||||
@nl @tab $operation_visibility$ $operation_result_type$ $operation_name$(
|
||||
@nl@tab$operation_visibility$ $operation_result_type$ $operation_name$(
|
||||
@foreach argument_list
|
||||
@if last_argument
|
||||
$argument_type$ $argument_name$
|
||||
@else
|
||||
$argument_type$ $argument_name$,
|
||||
$argument_type$ $argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
)
|
||||
@if notInterface
|
||||
{@nl@nl@tab}
|
||||
@spc{@nl
|
||||
@if operation_non_void
|
||||
@tab@tabreturn $returnvalue_stub$;
|
||||
@end
|
||||
@nl@tab}@nl
|
||||
@else
|
||||
;
|
||||
@end
|
||||
@end
|
||||
@nl }
|
||||
@nl}
|
||||
@end
|
||||
|
|
|
|||
|
|
@ -1,26 +1,30 @@
|
|||
@// Example template for Java
|
||||
@// assumption: all classifiers are classes
|
||||
@// Simple template for Java
|
||||
|
||||
@foreach classifier_list
|
||||
@openfile generated/$classifier_package_path$/$classifier_name$.java
|
||||
package $classifier_package$ ;
|
||||
@foreach nonprimitive_classifier_list
|
||||
@openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java
|
||||
package $classifier_package$;
|
||||
@nl@nl
|
||||
import tudresden.ocl20.core.lib.*;
|
||||
@nl
|
||||
@if isClass
|
||||
public class $classifier_name$
|
||||
@end
|
||||
@if isInterface
|
||||
public interface $classifier_name$
|
||||
@end
|
||||
@if isEnumeration
|
||||
public enum $classifier_name$
|
||||
@end
|
||||
@if notInterface
|
||||
@if hasParent
|
||||
extends $classifier_parent$
|
||||
@spcextends $classifier_parent$
|
||||
@end
|
||||
@end
|
||||
@if hasParentInterfaces
|
||||
@if isInterface
|
||||
extends
|
||||
@spcextends
|
||||
@else
|
||||
implements
|
||||
@spcimplements
|
||||
@end
|
||||
@foreach parent_interface_list
|
||||
@if last_interface
|
||||
|
|
@ -30,32 +34,88 @@
|
|||
@end
|
||||
@end
|
||||
@end
|
||||
@nl {
|
||||
@spc{
|
||||
@if notInterface
|
||||
@foreach attribute_list
|
||||
@nl @tab public $attribute_type$ $attribute_name$ ;
|
||||
@nl@tab$attribute_visibility$ $attribute_type$ $attribute_name$;
|
||||
@end
|
||||
@nl
|
||||
@end
|
||||
@// Operations of the class
|
||||
@foreach operation_list
|
||||
@nl @tab public $operation_result_type$ $operation_name$(
|
||||
@// The actual Operation, which is called by the wrapper below
|
||||
@nl@tab/**@nl@tab
|
||||
@spc* Actual implementation of $operation_name$. @nl@tab
|
||||
@spc*/
|
||||
@nl@tabprivate $operation_result_type$ wrapped_$operation_name$(
|
||||
@foreach argument_list
|
||||
$argument_type$ $argument_name$
|
||||
@if last_argument
|
||||
$argument_type$ $argument_name$
|
||||
@else
|
||||
$argument_type$ $argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
)
|
||||
@if notInterface
|
||||
@spc{@nl
|
||||
@if operation_non_void
|
||||
@tab@tabreturn $returnvalue_stub$;
|
||||
@end
|
||||
@nl@tab}@nl
|
||||
@else
|
||||
;
|
||||
@end
|
||||
@// The wrapper which calls the actual operation above
|
||||
@nl@tab/**@nl@tab
|
||||
@spc* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
|
||||
@spc*/
|
||||
@nl@tab$operation_visibility$ $operation_result_type$ $operation_name$(
|
||||
@foreach argument_list
|
||||
@if last_argument
|
||||
$argument_type$ $argument_name$
|
||||
@else
|
||||
$argument_type$ $argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
)
|
||||
@if notInterface
|
||||
@spc{
|
||||
@if operation_non_void
|
||||
@nl@tab@tab$operation_result_type$ result;@nl
|
||||
@end
|
||||
@nl@tab@tab// Check preconditions
|
||||
@nl$preconditions$
|
||||
@nl@tab@tab// Execute method @nl@tab@tab
|
||||
@if operation_non_void
|
||||
result =@spc
|
||||
@end
|
||||
wrapped_$operation_name$(
|
||||
@foreach argument_list
|
||||
@if last_argument
|
||||
$argument_name$
|
||||
@else
|
||||
$argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
);
|
||||
@nl@nl@tab@tab// Check postconditions
|
||||
@nl$postconditions$
|
||||
@nl@tab@tab// Check invariant
|
||||
@nl@tab@tabcheckInvariant();
|
||||
@if operation_non_void
|
||||
@nl@tab@tabreturn result;
|
||||
@end
|
||||
@nl@tab}@nl
|
||||
@else
|
||||
;
|
||||
@end
|
||||
)
|
||||
@if notInterface
|
||||
{
|
||||
@nl @tab @tab // Preconditions
|
||||
@nl $preconditions$
|
||||
@nl @tab @tab // Your Code
|
||||
@nl @tab @tab // Postconditions
|
||||
@nl $postconditions$
|
||||
@nl@tab }
|
||||
@else
|
||||
;
|
||||
@end
|
||||
@end
|
||||
@nl // Invariant
|
||||
@nl $invariants$
|
||||
@nl
|
||||
@nl }
|
||||
|
||||
@nl@tab/**
|
||||
@nl@tab@spc* Invariant
|
||||
@nl@tab@spc*/
|
||||
@nl@tabpublic void checkInvariant() {
|
||||
@nl$invariants$
|
||||
@nl@tab}
|
||||
@nl}
|
||||
@end
|
||||
|
|
|
|||
|
|
@ -8,46 +8,46 @@
|
|||
@openfile generated/src/test/java/$classifier_package_path$/$classifier_name$Test.java
|
||||
package $classifier_package$;
|
||||
@nl@nl
|
||||
@nl import java.io.FileNotFoundException;
|
||||
@nl import org.junit.BeforeClass;
|
||||
@nl import org.junit.Test;
|
||||
@nl import ch.ethz.infsec.jtestdataaccessor.TestDataAccessor;
|
||||
@nl import ch.ethz.infsec.jtestdataaccessor.TestDataParseException;
|
||||
@nl import ch.ethz.infsec.jtestdataaccessor.TestDataUser;
|
||||
@nl import ch.ethz.infsec.jtestdataaccessor.TestHelper;
|
||||
@nl import antlr.RecognitionException;
|
||||
@nl import antlr.TokenStreamException;
|
||||
@nl import tudresden.ocl20.core.lib.*;
|
||||
@nl import ch.ethz.infsec.jtestdataaccessor.oclexceptions.*;
|
||||
@nlimport java.io.FileNotFoundException;
|
||||
@nlimport org.junit.BeforeClass;
|
||||
@nlimport org.junit.Test;
|
||||
@nlimport ch.ethz.infsec.jtestdataaccessor.TestDataAccessor;
|
||||
@nlimport ch.ethz.infsec.jtestdataaccessor.TestDataParseException;
|
||||
@nlimport ch.ethz.infsec.jtestdataaccessor.TestDataUser;
|
||||
@nlimport ch.ethz.infsec.jtestdataaccessor.TestHelper;
|
||||
@nlimport antlr.RecognitionException;
|
||||
@nlimport antlr.TokenStreamException;
|
||||
@nlimport tudresden.ocl20.core.lib.*;
|
||||
@nlimport ch.ethz.infsec.jtestdataaccessor.oclexceptions.*;
|
||||
@nl
|
||||
@nl public class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser {
|
||||
@nlpublic class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser {
|
||||
|
||||
@nl@tab public static String classUnderTest = "$classifier_package$.$classifier_name$";
|
||||
@nl@tabpublic static String classUnderTest = "$classifier_package$.$classifier_name$";
|
||||
|
||||
@nl@nl@tab private static TestDataAccessor tda;
|
||||
@nl@nl@tabprivate static TestDataAccessor tda;
|
||||
|
||||
@nl@nl@tab private static TestHelper th;
|
||||
@nl@nl@tabprivate static TestHelper th;
|
||||
|
||||
@nl@nl@tab public String getClassUnderTest() {
|
||||
@nl@tab@tab return classUnderTest;
|
||||
@nl@nl@tabpublic String getClassUnderTest() {
|
||||
@nl@tab@tabreturn classUnderTest;
|
||||
@nl@tab}
|
||||
|
||||
@nl@nl@tabpublic Object getTestObject() {
|
||||
@nl@tab@tab return testObject;
|
||||
@nl@tab@tabreturn testObject;
|
||||
@nl@tab}
|
||||
|
||||
@nl@nl@tab \@BeforeClass
|
||||
@nl@tab public static void basicEnvSetup() throws FileNotFoundException, RecognitionException, TokenStreamException, TestDataParseException {
|
||||
@nl@tab@tab tda = new TestDataAccessor("src/test/resources/$classifier_package_path$/Testdata$classifier_name$");
|
||||
@nl@tab@tab th = new TestHelper(classUnderTest,tda);
|
||||
@nl@nl@tab\@BeforeClass
|
||||
@nl@tabpublic static void basicEnvSetup() throws FileNotFoundException, RecognitionException, TokenStreamException, TestDataParseException {
|
||||
@nl@tab@tabtda = new TestDataAccessor("src/test/resources/$classifier_package_path$/Testdata$classifier_name$");
|
||||
@nl@tab@tabth = new TestHelper(classUnderTest,tda);
|
||||
@nl@tab }
|
||||
|
||||
@foreach unique_operation_list
|
||||
@if operation_isNotPrivate
|
||||
@nl@nl@tab\@Test
|
||||
@nl@tab public void $operation_name$Test() throws Throwable {
|
||||
@nl@tab@tab String methodname = "$operation_name$";
|
||||
@nl@tab@tab th.doTest(methodname, this);
|
||||
@nl@tabpublic void $operation_name$Test() throws Throwable {
|
||||
@nl@tab@tabString methodname = "$operation_name$";
|
||||
@nl@tab@tabth.doTest(methodname, this);
|
||||
@nl@tab }
|
||||
@end
|
||||
@end
|
||||
|
|
@ -55,14 +55,14 @@
|
|||
@foreach operation_list
|
||||
@nl@nl@tab
|
||||
/**@nl@tab
|
||||
* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
|
||||
*/
|
||||
@nl@tab public $operation_result_type$ wrapped_$operation_name$(
|
||||
@spc* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
|
||||
@spc*/
|
||||
@nl@tabpublic $operation_result_type$ wrapped_$operation_name$(
|
||||
@foreach argument_list
|
||||
@if last_argument
|
||||
$argument_type$ $argument_name$
|
||||
@else
|
||||
$argument_type$ $argument_name$,
|
||||
$argument_type$ $argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
) throws Throwable {@nl
|
||||
|
|
@ -70,24 +70,24 @@
|
|||
@tab@tab$operation_result_type$ result;@nl
|
||||
@end
|
||||
@tab@tab// Check preconditions @nl
|
||||
$preconditions$@nl@tab@tab
|
||||
// Execute method @nl@tab@tab
|
||||
$preconditions$@nl
|
||||
@tab@tab// Execute method @nl@tab@tab
|
||||
@if operation_non_void
|
||||
result =
|
||||
result =@spc
|
||||
@end
|
||||
testObject.$operation_name$(
|
||||
@foreach argument_list
|
||||
@if last_argument
|
||||
$argument_name$
|
||||
@else
|
||||
$argument_name$,
|
||||
$argument_name$,@spc
|
||||
@end
|
||||
@end
|
||||
);@nl
|
||||
@tab@tab// Check postconditions @nl
|
||||
$postconditions$@nl
|
||||
@tab@tab// Check invariants @nl
|
||||
@tab@tab checkInvariant();
|
||||
@tab@tabcheckInvariant();
|
||||
@nl@tab@tab
|
||||
@if operation_non_void
|
||||
return result;
|
||||
|
|
@ -98,8 +98,8 @@
|
|||
|
||||
@nl@nl@tab
|
||||
/**@nl@tab
|
||||
* Check invariants of the class @nl@tab
|
||||
*/@nl@tab
|
||||
@spc* Check invariants of the class @nl@tab
|
||||
@spc*/@nl@tab
|
||||
public void checkInvariant() throws InvariantFailedException {@nl
|
||||
$invariants$
|
||||
@nl@tab}
|
||||
|
|
@ -111,12 +111,12 @@
|
|||
@//--------------------------
|
||||
@openfileifnotexists generated/src/test/java/$classifier_package_path$/Abstract$classifier_name$Test.java
|
||||
package $classifier_package$;
|
||||
@nl import $classifier_package$.$classifier_name$;
|
||||
@nl@nl public abstract class Abstract$classifier_name$Test {
|
||||
@nl@nlimport $classifier_package$.$classifier_name$;
|
||||
@nl@nlpublic abstract class Abstract$classifier_name$Test {
|
||||
|
||||
@nl@nl@tab static $classifier_name$ testObject;
|
||||
@nl@nl@tabstatic $classifier_name$ testObject;
|
||||
|
||||
@nl@nl }
|
||||
@nl@nl}
|
||||
|
||||
|
||||
@//----------------------
|
||||
|
|
@ -127,27 +127,34 @@
|
|||
@foreach operation_list
|
||||
@if operation_isNotPrivate
|
||||
[$operation_name$]
|
||||
@nl resulttype = $operation_result_type$;
|
||||
@if operation_non_void
|
||||
@nlresulttype = $operation_result_type$;
|
||||
@end
|
||||
@if operation_has_arguments
|
||||
@nl inputtypes =
|
||||
@nlinputtypes = @spc
|
||||
@foreach argument_list
|
||||
$argument_type$
|
||||
@if not_last_argument
|
||||
,
|
||||
,@spc
|
||||
@end
|
||||
@end
|
||||
;
|
||||
@end
|
||||
@nl #setup = ;
|
||||
@nl #teardown = ;
|
||||
@nl #{
|
||||
@nl #@tab input = ;
|
||||
@nl #@tab result = ;
|
||||
@nl #@tab checker = ;
|
||||
@nl #@tab comment = ;
|
||||
@nl #}
|
||||
@nl#setup = ;
|
||||
@nl#teardown = ;
|
||||
@nl#{
|
||||
@if operation_has_arguments
|
||||
@nl#@tab input = ;
|
||||
@end
|
||||
@if operation_non_void
|
||||
@nl#@tab result = ;
|
||||
@end
|
||||
@nl#@tab checker = ;
|
||||
@nl#@tab comment = ;
|
||||
@nl#}
|
||||
@nl@nl
|
||||
@end
|
||||
@end
|
||||
@end
|
||||
@end
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,45 @@
|
|||
@// Template for a maven Project Object Model (POM) file
|
||||
|
||||
@openfileifnotexists generated/pom.xml
|
||||
<?xml version="1.0"?>
|
||||
@nl<project>
|
||||
@nl@tab<modelVersion>4.0.0</modelVersion>
|
||||
@nl@tab<groupId>groupId<!-- insert a group ID, eg. your company name --></groupId>
|
||||
@nl@tab<artifactId>artifactId<!-- insert an artifact ID, eg. the package path --></artifactId>
|
||||
@nl@tab<name>name<!-- insert a name, eg. the project name --></name>
|
||||
@nl@tab<version>1.0-SNAPSHOT</version>
|
||||
@nl@tab<build>
|
||||
@nl@tab@tab<plugins>
|
||||
@nl@tab@tab@tab<plugin>
|
||||
@nl@tab@tab@tab@tab<artifactId>maven-compiler-plugin</artifactId>
|
||||
@nl@tab@tab@tab@tab<configuration>
|
||||
@nl@tab@tab@tab@tab@tab<source>1.5</source>
|
||||
@nl@tab@tab@tab@tab@tab<target>1.5</target>
|
||||
@nl@tab@tab@tab@tab</configuration>
|
||||
@nl@tab@tab@tab</plugin>
|
||||
@nl@tab@tab@tab<plugin>
|
||||
@nl@tab@tab@tab@tab<groupId>org.apache.maven.plugins</groupId>
|
||||
@nl@tab@tab@tab@tab<artifactId>maven-surefire-plugin</artifactId>
|
||||
@nl@tab@tab@tab@tab<version>2.3-SNAPSHOT</version>
|
||||
@nl@tab@tab@tab@tab<configuration>
|
||||
@nl@tab@tab@tab@tab@tab<forkMode>pertest</forkMode>
|
||||
@nl@tab@tab@tab@tab</configuration>
|
||||
@nl@tab@tab@tab</plugin>
|
||||
@nl@tab@tab</plugins>
|
||||
@nl@tab</build>
|
||||
@nl@tab<dependencies>
|
||||
@nl@tab@tab<dependency>
|
||||
@nl@tab@tab@tab<groupId>ch.ethz.infsec.jtestdataaccessor</groupId>
|
||||
@nl@tab@tab@tab<artifactId>jtestdataaccessor</artifactId>
|
||||
@nl@tab@tab@tab<version>1.0-SNAPSHOT</version>
|
||||
@nl@tab@tab@tab<scope>test</scope>
|
||||
@nl@tab@tab</dependency>
|
||||
@nl@tab@tab<dependency>
|
||||
@nl@tab@tab@tab<groupId>tudresden.ocl20</groupId>
|
||||
@nl@tab@tab@tab<artifactId>stdlib</artifactId>
|
||||
@nl@tab@tab@tab<version>1.0-SNAPSHOT</version>
|
||||
@nl@tab@tab@tab<!-- Remove the following line if you try to check conditions in the actual class, not in the unit tests -->
|
||||
@nl@tab@tab@tab<scope>test</scope>
|
||||
@nl@tab@tab</dependency>
|
||||
@nl@tab</dependencies>
|
||||
@nl@nl</project>
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
(list
|
||||
)
|
||||
(list
|
||||
(list "@nl\\|@tab"
|
||||
(list "@nl\\|@tab\\|@spc"
|
||||
'(0 font-lock-builtin-face))
|
||||
(list "\\W\\(@if\\|@elsif\\)[ \t]*\\([a-zA-Z_-]*\\)\\W"
|
||||
'(1 font-lock-keyword-face)
|
||||
|
|
|
|||
|
|
@ -154,7 +154,7 @@ fun getContent l = let val sl = tokenize l
|
|||
handle ex => error ("in Tpl_Parser.getContent: "^General.exnMessage ex)
|
||||
|
||||
(** cleans line, replaces nl and tabs so that no space char is left out. *)
|
||||
fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
|
||||
fun preprocess s = replaceSafely "@spc" " " (replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s)))
|
||||
|
||||
|
||||
(**
|
||||
|
|
|
|||
|
|
@ -1,28 +1,88 @@
|
|||
(**
|
||||
* A counter for the variables which returns a new number on each
|
||||
* next()/nextstr() call.
|
||||
*)
|
||||
structure varcounter = struct
|
||||
val count = ref ~1
|
||||
|
||||
(** Increment and return the counter value. *)
|
||||
fun next() = (count := !count + 1; !count)
|
||||
|
||||
(** Increment and return the counter value as a string. *)
|
||||
fun nextStr() = Int.toString (next())
|
||||
|
||||
(** Reset the counter to -1. *)
|
||||
fun reset() = (count := ~1)
|
||||
|
||||
(** Get the current value. *)
|
||||
fun current() = !count
|
||||
|
||||
(** Get the current value as a string. *)
|
||||
fun currentStr() = Int.toString(current())
|
||||
end
|
||||
|
||||
|
||||
(**
|
||||
* A map to store the relation of values calculated before the function
|
||||
* call which are used in @pre terms.
|
||||
*)
|
||||
structure preMap = struct open library
|
||||
val entries : (string * int) list ref = ref nil
|
||||
|
||||
(** Insert a new entry - if an entry with the same key already exists, it will be removed. *)
|
||||
fun put (key : string) (value : int) = entries := (key,value)::(List.filter (fn (entry) => (fst entry) <> key) (!entries))
|
||||
|
||||
(** Get the entry with the given key. *)
|
||||
fun get (key : string) = case (List.filter (fn (entry) => (fst entry) = key) (!entries)) of
|
||||
[result] => snd result
|
||||
| _ => ~1
|
||||
|
||||
(** Check if an entry with the given key exists. *)
|
||||
fun has (key : string) = foldr (fn (a,b) => ((fst a) = key) orelse b) false (!entries)
|
||||
|
||||
(** Clear the list. *)
|
||||
fun clear () = entries := nil
|
||||
|
||||
(** Get the current size of the list. *)
|
||||
fun size () = List.length (!entries)
|
||||
end
|
||||
|
||||
|
||||
(**
|
||||
* Conversion of OCL expressions to Java code which makes use of the
|
||||
* Dresden standard ocl library.
|
||||
*)
|
||||
structure Ocl2DresdenJava = struct open library open Rep_OclType open Rep_OclTerm open Rep_Core open Ocl2String
|
||||
|
||||
structure varcounter = struct
|
||||
val count = ref ~1
|
||||
fun next() = (count := !count + 1; !count)
|
||||
fun nextStr() = Int.toString (next())
|
||||
fun reset() = (count := ~1)
|
||||
fun current() = !count
|
||||
fun currentStr() = Int.toString(current())
|
||||
end
|
||||
|
||||
structure Ocl2DresdenJava = struct open library open Rep_OclType open Rep_OclTerm open Rep_Core
|
||||
|
||||
fun ocl2java' oclterm on =
|
||||
(**
|
||||
* Convert an oclterm to Java. 'on' should be the object which represents
|
||||
* self, so in most cases it will be 'this'. The result is string * int
|
||||
* where string is the generated code and int is the id of the oclNode which
|
||||
* contains the result of the generated code (ie. the last node which got
|
||||
* assigned a value in the generated code).
|
||||
*)
|
||||
fun ocl2java' oclterm on =
|
||||
let
|
||||
(* Get the oclNode number as a string. *)
|
||||
fun count res = Int.toString(snd res)
|
||||
|
||||
(* Get the generated code. *)
|
||||
fun code res = fst res
|
||||
|
||||
(* Generate a new node of type ntype which gets assigned the result of ncode. *)
|
||||
fun newNode ntype ncode = "final "^ntype^" oclNode"^(varcounter.nextStr())^" = "^ncode^";\n"
|
||||
|
||||
(* Generate a new UmlOclFactory. *)
|
||||
fun newFact () = ("final UmlOclFactory oclFact"^(varcounter.nextStr())^" = UmlOclFactory.getInstance();\n",
|
||||
varcounter.current())
|
||||
|
||||
(* Convert a node id to oclNode<id>. *)
|
||||
fun node nid = "oclNode"^(count nid)
|
||||
|
||||
(* Convert a node id to oclFact<id>. *)
|
||||
fun fact fid = "oclFact"^(count fid)
|
||||
|
||||
(* Generate code for an if statement by evaluating condition and the two branches. *)
|
||||
fun ifStmt cond thenb elseb rest =
|
||||
let
|
||||
val condition = ocl2java' cond on
|
||||
|
|
@ -35,58 +95,82 @@ fun ocl2java' oclterm on =
|
|||
(newNode ("Ocl"^(string_of_OclType rest)) ("Ocl.toOcl"^(string_of_OclType rest)^"("^(node condition)^".ifThenElse("^(node thenbranch)^", "^(node elsebranch)^"))")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Get an object which represents the given OclType. *)
|
||||
fun typeObj ptype =
|
||||
case ptype of (Classifier p) =>
|
||||
let
|
||||
val factory = newFact ()
|
||||
val oclmodeltype = newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")")
|
||||
in
|
||||
((code factory)^
|
||||
oclmodeltype,
|
||||
varcounter.current())
|
||||
end
|
||||
| (Set s) =>
|
||||
let
|
||||
val setType = typeObj s
|
||||
in
|
||||
((code setType)^
|
||||
(newNode "OclCollectionType" ((node setType)^".getOclSetType()")),
|
||||
varcounter.current())
|
||||
end
|
||||
| OclAny =>
|
||||
((newNode "OclType" ("OclType.getOclAny()")),
|
||||
varcounter.current())
|
||||
| _ =>
|
||||
(newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
|
||||
|
||||
(* Get the node id of the node which stores the result of src which was used in an @pre expression. *)
|
||||
fun atPre src = ("", preMap.get(ocl2string true src))
|
||||
|
||||
(* Generate code for an attribute/association end call. *)
|
||||
fun attrCall src path ptype =
|
||||
let
|
||||
val target = ocl2java' src on
|
||||
fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
|
||||
in
|
||||
case ptype of (Classifier p) =>
|
||||
let
|
||||
val factory = newFact ()
|
||||
val oclmodeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")"),varcounter.current())
|
||||
in
|
||||
((code factory)^
|
||||
(code target)^
|
||||
(code oclmodeltype)^
|
||||
(node' "ModelObject" oclmodeltype),
|
||||
varcounter.current())
|
||||
end
|
||||
| _ =>
|
||||
let
|
||||
val oclprimtype = (newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
|
||||
in
|
||||
((code target)^
|
||||
(code oclprimtype)^
|
||||
(node' (string_of_OclType ptype) oclprimtype),
|
||||
varcounter.current())
|
||||
end
|
||||
end
|
||||
|
||||
case src of OperationCall (osrc,styp,["oclLib","OclAny","atPre"],[],_) => atPre oclterm
|
||||
| _ =>
|
||||
let
|
||||
val target = ocl2java' src on
|
||||
val typeObject = typeObj ptype
|
||||
fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
|
||||
in
|
||||
case ptype of (Classifier p) =>
|
||||
((code target)^
|
||||
(code typeObject)^
|
||||
(node' "ModelObject" typeObject),
|
||||
varcounter.current())
|
||||
| (Set s) =>
|
||||
((code target)^
|
||||
(code typeObject)^
|
||||
(node' "Set" typeObject),
|
||||
varcounter.current())
|
||||
| _ =>
|
||||
((code target)^
|
||||
(code typeObject)^
|
||||
(node' (string_of_OclType ptype) typeObject),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Access to a variable - this is either self, result or an argument to the function call. *)
|
||||
fun var name t =
|
||||
let
|
||||
val factory = newFact ()
|
||||
val vname = if name = "self" then on else name
|
||||
val vtype = typeObj t
|
||||
fun node' typ typobj = newNode ("Ocl"^typ) ("(Ocl"^typ^")"^(fact factory)^".getOclRepresentationFor("^(node typobj)^", "^vname^")")
|
||||
in
|
||||
case t of Integer =>
|
||||
let
|
||||
val integertype = (newNode "OclPrimitiveType" "OclPrimitiveType.getOclInteger()",varcounter.current())
|
||||
in
|
||||
((code factory)^
|
||||
(code integertype)^
|
||||
(newNode "OclInteger" ("(OclInteger)"^(fact factory)^".getOclRepresentationFor("^(node integertype)^", "^vname^")")),
|
||||
varcounter.current())
|
||||
end
|
||||
| _ =>
|
||||
let
|
||||
val modeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon t)^"\")"),
|
||||
varcounter.current())
|
||||
in
|
||||
((code factory)^
|
||||
(code modeltype)^
|
||||
(newNode "OclModelObject" ("(OclModelObject)"^(fact factory)^".getOclRepresentationFor("^(node modeltype)^", "^vname^")")),
|
||||
varcounter.current())
|
||||
end
|
||||
case t of (Classifier p) =>
|
||||
((code factory)^
|
||||
(code vtype)^
|
||||
(node' "ModelObject" vtype),
|
||||
varcounter.current())
|
||||
| _ =>
|
||||
((code factory)^
|
||||
(code vtype)^
|
||||
(node' (string_of_OclType t) vtype),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for binary operations on basic types. *)
|
||||
fun string_of_binop src bop arg rtype =
|
||||
let
|
||||
val left = ocl2java' src on
|
||||
|
|
@ -97,6 +181,8 @@ fun ocl2java' oclterm on =
|
|||
(newNode ("Ocl"^(string_of_OclType rtype)) ((node left)^"."^bop^"("^(node right)^")")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for unary operations on basic types. *)
|
||||
fun string_of_unop src sop rtype =
|
||||
let
|
||||
val right = ocl2java' src on
|
||||
|
|
@ -105,8 +191,12 @@ fun ocl2java' oclterm on =
|
|||
(newNode ("Ocl"^(string_of_OclType rtype)) ((node right)^"."^sop^"()")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Get an empty set. *)
|
||||
fun emptySet () = (newNode "OclSet" "OclSet.getEmptyOclSet()",
|
||||
varcounter.current())
|
||||
|
||||
(* Insert the result of src into an empty set. *)
|
||||
fun oclset src =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
|
|
@ -117,6 +207,8 @@ fun ocl2java' oclterm on =
|
|||
(node set)^".setToInclude("^(node src')^");\n",
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->notEmpty() operation. *)
|
||||
fun oclnotempty src =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
|
|
@ -125,6 +217,8 @@ fun ocl2java' oclterm on =
|
|||
(newNode "OclBoolean" ((node src')^".notEmpty()")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->isEmpty() operation. *)
|
||||
fun oclempty src =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
|
|
@ -133,6 +227,8 @@ fun ocl2java' oclterm on =
|
|||
(newNode "OclBoolean" ((node src')^".isEmpty()")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->size() operation. *)
|
||||
fun oclsize src =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
|
|
@ -141,96 +237,257 @@ fun ocl2java' oclterm on =
|
|||
(newNode "OclInteger" ((node src')^".size()")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
|
||||
(* Generate code for a function call. Evaluate parameters and pass them to the call. *)
|
||||
fun opCall src op_name args rtype =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
val resultTypeObj = typeObj rtype
|
||||
(* Evaluate arguments, generate new node with the result. *)
|
||||
fun evalArg (arg,atype) =
|
||||
let
|
||||
val acode = ocl2java' arg on
|
||||
fun umltype utype = case utype of
|
||||
Integer => "UmlType.INT"
|
||||
| Real => "UmlType.REAL"
|
||||
| String => "UmlType.STRING"
|
||||
| Boolean => "UmlType.BOOLEAN"
|
||||
| _ => "UmlType.MODELTYPE"
|
||||
in
|
||||
((code acode)^
|
||||
(newNode "OclParameter" ("new OclParameter("^(umltype atype)^", "^(node acode)^")")),
|
||||
varcounter.current())
|
||||
end
|
||||
val arguments = map evalArg args
|
||||
val argcode = join "" (map fst arguments)
|
||||
(* Evaluated arguments *)
|
||||
val argsEvald = join ", " (map (fn a => node a) arguments)
|
||||
fun node' typ typobj = argcode^(newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node src')^".getFeature("^(node typobj)^", \""^(hd (rev op_name))^"\", new OclParameter[]{"^argsEvald^"}))"))
|
||||
in
|
||||
case rtype of (Classifier p) =>
|
||||
((code src')^
|
||||
(code resultTypeObj)^
|
||||
(node' "ModelObject" resultTypeObj),
|
||||
varcounter.current())
|
||||
| _ =>
|
||||
((code src')^
|
||||
(code resultTypeObj)^
|
||||
(node' (string_of_OclType rtype) resultTypeObj),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->oclAsType() operation. *)
|
||||
fun oclAsType src oclType rtyp =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
val typeObject = typeObj rtyp
|
||||
in
|
||||
case oclType of
|
||||
OclAny =>
|
||||
((code src')^
|
||||
(code typeObject)^
|
||||
(newNode "OclAny" ("Ocl.toOclAny("^(node src')^".oclAsType("^(node typeObject)^"))")),
|
||||
varcounter.current())
|
||||
| _ =>
|
||||
((code src')^
|
||||
(code typeObject)^
|
||||
(newNode "OclModelObject" ("Ocl.toOclModelObject("^(node src')^".oclAsType("^(node typeObject)^"))")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->oclIsUndefined() operation. *)
|
||||
fun oclIsUndefined src =
|
||||
let
|
||||
val src' = ocl2java' src on
|
||||
in
|
||||
((code src')^
|
||||
(newNode "OclBoolean" ("OclBoolean.getOclRepresentationFor("^(node src')^".isUndefined())")),
|
||||
varcounter.current())
|
||||
end
|
||||
|
||||
(* Generate code for the ->oclIsDefined() operation. *)
|
||||
fun oclIsDefined src =
|
||||
let
|
||||
val src' = oclIsUndefined src
|
||||
in
|
||||
((code src')^
|
||||
(newNode "OclBoolean" ((node src')^".not()")),
|
||||
varcounter.current())
|
||||
end
|
||||
in
|
||||
case oclterm of
|
||||
Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
|
||||
| Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
|
||||
| Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
|
||||
(* Logical operators *)
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
|
||||
(* Comparison operators *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
||||
(* OCL Real *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
|
||||
(* OCL Integer *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
|
||||
(* OCL Numerals *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
|
||||
(* Some collection operations *)
|
||||
| OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
|
||||
| OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
|
||||
| OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
|
||||
| OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
|
||||
(* If *)
|
||||
| If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
|
||||
(* Access to attributes *)
|
||||
| AttributeCall (src,styp,path,ptype) => attrCall src path ptype
|
||||
(* Access to variables *)
|
||||
| Variable (name, t) => var name t
|
||||
| _ => (Ocl2String.ocl2string true oclterm, 0)
|
||||
case oclterm of
|
||||
(* Literals *)
|
||||
Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
|
||||
| Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
|
||||
| Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
|
||||
| Literal (s,String) => (newNode "OclString" ("new OclString(\""^s^"\")"),varcounter.current())
|
||||
| Literal (r,Real) => (newNode "OclReal" ("new OclReal("^r^")"),varcounter.current())
|
||||
(* Logical operators *)
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
|
||||
| OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
|
||||
(* Comparison operators *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
|
||||
(* OCL Real *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
|
||||
| OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
|
||||
(* OCL Integer *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
|
||||
(* OCL Numerals *)
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
|
||||
| OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
|
||||
(* Some collection operations *)
|
||||
| OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
|
||||
| OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
|
||||
| OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
|
||||
| OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
|
||||
(* oclIs(Und|D)efined *)
|
||||
| OperationCall (src,styp,["oclIsDefined"],[],rtyp) => oclIsDefined src
|
||||
| OperationCall (src,styp,["oclIsUndefined"],[],rtyp) => oclIsUndefined src
|
||||
(* @pre *)
|
||||
| OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => atPre src
|
||||
(* Unsupported call - TODO: maybe replace by error "..."? *)
|
||||
| OperationCall (src,styp,[opname],[],rtyp) => (("/* Unsupported OCL operation "^opname^". */\n"),varcounter.current())
|
||||
(* If *)
|
||||
| If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
|
||||
(* Access to attributes *)
|
||||
| AttributeCall (src,stype,path,ptype) => attrCall src path ptype
|
||||
(* Access association ends *)
|
||||
| AssociationEndCall (src,stype,path,ptype) => attrCall src path ptype
|
||||
(* Access to variables *)
|
||||
| Variable (name, t) => var name t
|
||||
(* Function calls *)
|
||||
| OperationCall (src,styp,op_name,args,rtype) => opCall src op_name args rtype
|
||||
(* oclAsType *)
|
||||
| OperationWithType (src,styp,"oclAsType",oclType,rtyp) => oclAsType src oclType rtyp
|
||||
(* Print currently unknown stuff using ocl2string. TODO: maybe replace by error "..."? *)
|
||||
| _ => ("/* "^(ocl2string true oclterm)^" */\n", 0)
|
||||
end
|
||||
|
||||
(** Return the Java code which evaluates the oclterm. *)
|
||||
fun ocl2java oclterm on = fst (ocl2java' oclterm on)
|
||||
|
||||
(* Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string *)
|
||||
(** Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string. *)
|
||||
fun opargs2string args =
|
||||
let
|
||||
fun arg2string (name,typ) = (Rep_OclType.string_of_OclType typ)^" "^name
|
||||
in
|
||||
join ", " (List.map arg2string args )
|
||||
end
|
||||
|
||||
|
||||
(** Return ocl formula as a Java comment. *)
|
||||
fun oclComment formula = "/* "^(ocl2string false formula)^" */\n"
|
||||
|
||||
(* Check the result of checking a condition *)
|
||||
fun checkConditionResult condition name condType uut =
|
||||
(** Check the result of checking a condition. *)
|
||||
fun checkConditionResult condition name condType ex uut =
|
||||
let
|
||||
val name' = case name of SOME t => " "^t
|
||||
| NONE => ""
|
||||
in
|
||||
(fst condition)^
|
||||
"if(!oclNode"^(Int.toString(snd condition))^".isTrue()){"^
|
||||
"\n\tthrow new "^condType^"FailedException(\""^condType^name'^" of "^uut^" failed!\");\n"^
|
||||
"\n\tthrow new "^ex^"(\""^condType^name'^" of "^uut^" failed!\");\n"^
|
||||
"}\n"
|
||||
end
|
||||
|
||||
(* Create the string which checks preconditions *)
|
||||
fun precondString env on curOp =
|
||||
let fun getPrecond precond = checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
|
||||
|
||||
(** Extract @pre operations from the postconditions, generate code to save @pre values. *)
|
||||
fun preExtract env on curOp =
|
||||
let
|
||||
fun getPres precond =
|
||||
let
|
||||
(* Save the result of attribute/association end calls. *)
|
||||
fun attSave src stype path ptype call = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
|
||||
let
|
||||
val condstr = ocl2string true precond
|
||||
in
|
||||
if not (preMap.has(condstr)) then
|
||||
let
|
||||
val code = ocl2java' (call (asrc,stype,path,ptype)) on
|
||||
in
|
||||
((preMap.put condstr (snd code));
|
||||
(fst code))
|
||||
end
|
||||
else
|
||||
""
|
||||
end
|
||||
| _ => getPres src
|
||||
(* Save the result of function calls. *)
|
||||
fun resSave src styp op_name args rtype = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
|
||||
let
|
||||
val condstr = ocl2string true asrc
|
||||
in
|
||||
if not (preMap.has(condstr)) then
|
||||
let
|
||||
val code = ocl2java' asrc on
|
||||
in
|
||||
((preMap.put condstr (snd code));
|
||||
(fst code))
|
||||
end
|
||||
else
|
||||
""
|
||||
end
|
||||
| _ => (getPres src)^(join "\n" (map (getPres o fst) args))
|
||||
in
|
||||
case precond of
|
||||
OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => error "atPre()-operation should not be reached."
|
||||
| OperationCall (src,styp,op_name,args,rtype) => resSave src styp op_name args rtype
|
||||
| Literal (_,_) => ""
|
||||
| If (cond,_,thenb,_,elseb,_,_) => (getPres cond)^(getPres thenb)^(getPres elseb)
|
||||
| AttributeCall (src,stype,path,ptype) => attSave src stype path ptype AttributeCall
|
||||
| AssociationEndCall (src,stype,path,ptype) => attSave src stype path ptype AssociationEndCall
|
||||
| Variable (_,_) => ""
|
||||
| OperationWithType (src,_,_,_,_) => getPres src
|
||||
| _ => ""
|
||||
end
|
||||
in
|
||||
join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp))
|
||||
join "\n" (List.map (getPres o snd) (Rep_Core.postcondition_of_op curOp))
|
||||
end
|
||||
|
||||
(* Create the string which checks postconditions *)
|
||||
fun postcondString env on curOp =
|
||||
let fun getPostcond postcond = checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
|
||||
(** Create the string which checks preconditions. *)
|
||||
fun precondString env on curOp ex =
|
||||
let
|
||||
fun getPrecond precond =
|
||||
(oclComment (snd precond))^
|
||||
(checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
|
||||
in
|
||||
(preMap.clear();
|
||||
(join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp)))^
|
||||
("\n/* Save values used in @pre-expressions of the postcondition */\n"^
|
||||
(preExtract env on curOp)))
|
||||
end
|
||||
|
||||
(** Create the string which checks postconditions. *)
|
||||
fun postcondString env on curOp ex =
|
||||
let
|
||||
fun getPostcond postcond =
|
||||
(oclComment (snd postcond))^
|
||||
(checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
|
||||
in
|
||||
join "\n" (List.map getPostcond (Rep_Core.postcondition_of_op curOp))
|
||||
end
|
||||
|
||||
(* Create the string which checks invariants *)
|
||||
fun invString env on curCl =
|
||||
let fun getInvariant invariant = checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" (Rep_Core.short_name_of curCl)
|
||||
(** Create the string which checks invariants. *)
|
||||
fun invString env on curCl ex =
|
||||
let
|
||||
fun getInvariant invariant =
|
||||
(oclComment (snd invariant))^
|
||||
(checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" ex (Rep_Core.short_name_of curCl))
|
||||
in
|
||||
join "\n" (List.map getInvariant (Rep_Core.invariant_of curCl))
|
||||
end
|
||||
|
|
|
|||
|
|
@ -82,7 +82,10 @@ fun ocl2string show_types oclterm =
|
|||
(* Literal *)
|
||||
(**************************************)
|
||||
(* OCL Boolean *)
|
||||
Literal (lit, typ) => if show_types
|
||||
Literal (s, String) => if show_types
|
||||
then "(\""^s^"\":"^(string_of_OclType String)^")"
|
||||
else "\""^s^"\""
|
||||
| Literal (lit, typ) => if show_types
|
||||
then "("^lit^":"^(string_of_OclType typ)^")"
|
||||
else lit
|
||||
| CollectionLiteral (parts, typ as Bag x) => "Bag{"^(collection_part_list show_types parts)^"}"
|
||||
|
|
@ -100,8 +103,8 @@ fun ocl2string show_types oclterm =
|
|||
^" else "^(ocl2string show_types eterm)^" endif"
|
||||
| AssociationEndCall(src,styp,path,ptyp) => if show_types
|
||||
then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")."
|
||||
^(string_of_path path)^":"^(string_of_OclType ptyp)^")"
|
||||
else (ocl2string show_types src)^"."^(string_of_path path)
|
||||
^(hd (rev path))^":"^(string_of_OclType ptyp)^")"
|
||||
else (ocl2string show_types src)^"."^(hd (rev path))
|
||||
| AttributeCall(src,styp,path,ptyp) => if show_types
|
||||
then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")."
|
||||
^(hd (rev path))^":"^(string_of_OclType ptyp)^")"
|
||||
|
|
@ -154,7 +157,7 @@ fun ocl2string show_types oclterm =
|
|||
| OperationCall (src,styp,op_name,args,t) => if show_types
|
||||
then "("^(ocl2string show_types src)^"."^(hd (rev op_name))
|
||||
^"("^arglist show_types args^")"
|
||||
^")"^(string_of_OclType t)
|
||||
^"):"^(string_of_OclType t)
|
||||
else (ocl2string show_types src)^"."^(hd (rev op_name))
|
||||
^"("^arglist show_types args^")"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue