home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / modelcheck.tcl < prev    next >
Text File  |  1997-09-05  |  15KB  |  587 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)modelcheck.tcl    /main/titanic/9
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)modelcheck.tcl    /main/titanic/9   5 Sep 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require wmt_util.tcl
  14. require caynutil.tcl
  15. require legacy.tcl
  16. require chktcl_msg.tcl
  17. require libsql.tcl
  18. require checkutil.tcl
  19.  
  20. global booleanOptions;        set booleanOptions {
  21.                     {-debug debug 0}
  22.                     {-global global 0}
  23.                     {-usecase usecase 0}
  24.                 }
  25.  
  26. OTShRegister::reportWriter
  27.  
  28. # next variable and procs should be redefined in 'checkconf.tcl'
  29. #
  30. global dbobject_name;    set dbobject_name DBObject
  31. proc set_name {class {ordered 0}} {
  32.     return "${class}Set"
  33.  }
  34. proc set_type_name {class {ordered 0}} {
  35.     return "SetOf[$class getName]"
  36.  }
  37. proc add_predefined_methods {ooplmodel} {
  38.  }
  39. proc prepare_db_class {class model} {
  40.  }
  41.  
  42. # End user added include file section
  43.  
  44.  
  45. Class ModelChecker : {GCObject} {
  46.     method destructor
  47.     constructor
  48.     method check
  49.     method checkModel
  50.     method checkLangModel
  51.     method loadModel
  52.     method parseCmdLine
  53.     method parseOptions
  54.     method setCheckStatus
  55.     method getSelectedOoplClasses
  56.     method getSelectedOoplSubjects
  57.     method getSourceClasses
  58.     attribute sources
  59.     attribute eventTypes
  60.     attribute eventDiagram
  61.     attribute srcCount
  62.     attribute exclClassFilter
  63.     attribute ooplClasses
  64.     attribute ooplSubjects
  65.     attribute codNames
  66.     attribute ooModel
  67.     attribute ooplModel
  68. }
  69.  
  70. method ModelChecker::destructor {this} {
  71.     # Start destructor user section
  72.     # End destructor user section
  73. }
  74.  
  75. constructor ModelChecker {class this {sources {}} {eventTypes {}}} {
  76.     set this [GCObject::constructor $class $this]
  77.     # Start constructor user section
  78.     set sources [flatten $sources]
  79.     $this sources $sources
  80.     if {[llength $sources] == 1} {
  81.     set diagType [nt_get_type $sources]
  82.     if {$diagType == "ccd" || $diagType == "etd" || $diagType == "std"} {
  83.         lappend eventTypes $diagType
  84.         $this eventDiagram $sources
  85.     }
  86.     }
  87.     $this eventTypes [flatten $eventTypes]
  88.     # End constructor user section
  89.     return $this
  90. }
  91.  
  92. method ModelChecker::check {this} {
  93.     #
  94.     # Check UseCase or Local/Global Model.
  95.     #
  96.     m4_message $M_STARTING_EXTENDED_CHECKING
  97.     M4CheckManager::resetErrorCount
  98.     $this parseOptions
  99.  
  100.     if {$usecase} {
  101.     uplevel #0 {
  102.         require chkucmodel.tcl
  103.         #
  104.         # Load user customizations, if present.
  105.         #
  106.         set cc [ClientContext::global]
  107.         if {[$cc customFileExists u_check tcl "" 0]} {
  108.         require u_check.tcl
  109.         }
  110.     }
  111.     puts stdout "\nChecking the Use Case model.\n"
  112.     checkUseCaseModel
  113.         CheckUtil::showErrors
  114.     return
  115.     }
  116.  
  117.     OTShRegister::check
  118.     uplevel #0 {
  119.     require chkmodel.tcl
  120.     require chkcomodel.tcl
  121.  
  122.     set cc [ClientContext::global]
  123.     if {[$cc customFileExists checkconf tcl "" 0]} {
  124.         require checkconf.tcl
  125.     }
  126.     #
  127.     # Load user customizations, if present.
  128.     #
  129.     if {[$cc customFileExists u_check tcl "" 0]} {
  130.         require u_check.tcl
  131.     }
  132.  
  133.     #
  134.     # Load language dependent checks, if present.
  135.     #
  136.     if {[$cc customFileExists langcheck tcl tcl]} {
  137.         OTShRegister::codeGeneration
  138.         require langcheck.tcl
  139.     }
  140.     #
  141.     # Load user customizations, if present.
  142.     #
  143.     if {[$cc customFileExists u_langcheck tcl "" 0]} {
  144.         require u_langcheck.tcl
  145.     }
  146.     }
  147.  
  148.     $this checkModel
  149. }
  150.  
  151. method ModelChecker::checkModel {this} {
  152.     #
  153.     # Main entry point for extended checking
  154.     #
  155.     $this parseCmdLine
  156.  
  157.     set cc [ClientContext::global]
  158.     if {[$cc currentLevel] == "File"} {
  159.     $cc upLevel
  160.     }   
  161.     $this loadModel $global 0 1
  162.     if {[$this ooModel] == ""} {
  163.         m4_message $M_LOADING_OOPL_FAILED
  164.         CheckUtil::showErrors
  165.         return
  166.     }
  167.  
  168.     set modelKind local
  169.     if {$global} {
  170.     set modelKind global
  171.     }
  172.  
  173.     #
  174.     # Check the language/target model
  175.     # Note that this done *before* preparing the model
  176.     #
  177.     if {[nt_get_type [$cc levelNameAt Phase]] == "ObjectDesign"} {
  178.     $this checkLangModel $modelKind
  179.     }
  180.  
  181.     #
  182.     # Prepare the model for local/global checking
  183.     #
  184.     puts stdout "\nPreparing the $modelKind model for checking.\n"
  185.     [$this ooplModel] prepare [$this ooplClasses] [$this ooplSubjects] check
  186.     if {[[$this ooModel] error] > 0} {
  187.         m4_message $M_PREPARE_CHECK_FAILED
  188.         [$this ooModel] delete
  189.         return
  190.     }
  191.  
  192.     #
  193.     # Check the internal model
  194.     #
  195.     set classNames {}
  196.     foreach ooplClass [$this ooplClasses] {
  197.     lappend classNames [$ooplClass getName]
  198.     }
  199.     [$this ooplModel] check $classNames
  200.     unset classNames
  201.     #
  202.     #set sqlmodel [[$this ooModel] sqlModel]
  203.     #$sqlmodel check
  204.  
  205.     #
  206.     # Check the local/global model
  207.     #
  208.     puts stdout "\nChecking the $modelKind model.\n"
  209.     [$this ooplModel] mcheck [$this ooplClasses] [$this ooplSubjects]
  210.  
  211.     #
  212.     # Check the Collaboration model
  213.     #
  214.     if {$global || [$this codNames] != {}} {
  215.     puts stdout "\nChecking the Collaboration model.\n"
  216.     if {$global} {
  217.         $this codNames {}
  218.     }
  219.     checkCollaborationModel [$this codNames]
  220.     }
  221.  
  222.     CheckUtil::showErrors
  223.  
  224.     #
  225.     # Update check statusses of all specified diagrams.
  226.     #
  227.     # Note that this may set the status of a diagram incorrectly, for
  228.     # example if a diagram was specified that did not contain any
  229.     # incorrect classes.
  230.     #
  231.     foreach diagram [$this sources] {
  232.     if {[string first "." $diagram] > 0} {
  233.             set status [expr {([M4CheckManager::getErrorCount] == 0) ? "ok" : "failed"}]
  234.         if {[catch {$this setCheckStatus $diagram $status} msg]} {
  235.                 puts stdout "$diagram: $msg\n"
  236.             }
  237.     }
  238.     }
  239. }
  240.  
  241. method ModelChecker::checkLangModel {this modelKind} {
  242.     #
  243.     # If possible, call proc langCheck
  244.     #
  245.     if {[info procs langCheck] != ""} {
  246.     #puts stdout "\nDoing language dependent checking on model.\n"
  247.     puts stdout "\nChecking the $modelKind target language model.\n"
  248.     set classList [List new]
  249.     foreach class [$this ooplClasses] {
  250.         if {![$class isExternal]} {
  251.         $classList append $class
  252.         }
  253.     }
  254.     langCheck $classList
  255.     }
  256. }
  257.  
  258. method ModelChecker::loadModel {this global {quiet 0} {subjects 1}} {
  259.     #
  260.     # Set this ooModel, this ooplModel, this ooplClasess and this ooplSubjects
  261.     # (Un)set this sources and this exclClassFilter, if needed
  262.     #
  263.     $this ooModel [OOModel::createModel]
  264.     if {[[$this ooModel] error] > 0} {
  265.         [$this ooModel] delete
  266.     $this ooModel ""
  267.         return
  268.     }
  269.     $this ooplModel [[$this ooModel] ooplModel]
  270.  
  271.     if {$global} {
  272.     #
  273.     # Global checking
  274.     #    - load all classes, except the ones specified.
  275.         #    - if (subjects) load all Subjects in the system.
  276.     #
  277.     $this exclClassFilter [$this sources]
  278.     $this sources {}
  279.         if {!$quiet} {
  280.         m4_message $M_LOADING_MODEL
  281.         }
  282.     } else {
  283.     #
  284.     # Local checking
  285.     #    - load the specified classes.
  286.         #    - if (subjects) load the Subjects in the specified diagrams.
  287.     #
  288.     $this exclClassFilter {}
  289.         if {[lempty [$this sources]]} {
  290.         if {!$quiet} {
  291.                 m4_message $M_NO_CLASSES_SPECIFIED
  292.             }
  293.             return
  294.         }
  295.         if {!$quiet} {
  296.             m4_message $M_LOADING_SPECIFIED
  297.         }
  298.     }
  299.  
  300.     $this ooplClasses [$this getSelectedOoplClasses]
  301.     foreach ooplClass [$this ooplClasses] {
  302.     $ooplClass setReceivedEvents [$this eventTypes] [$this eventDiagram]
  303.     }
  304.  
  305.     if {$subjects} {
  306.     $this ooplSubjects [$this getSelectedOoplSubjects]
  307.     foreach ooplSubject [$this ooplSubjects] {
  308.         $ooplSubject setReceivedEvents [$this eventTypes] [$this eventDiagram]
  309.     }
  310.     }
  311. }
  312.  
  313. method ModelChecker::parseCmdLine {this} {
  314.     set sources {}
  315.     set eventTypes {}
  316.     set srcCount 0
  317.     set codNames {}
  318.     foreach src [CommandLineInterface::getSourceObjects] {
  319.     incr srcCount
  320.     set diagType [nt_get_type $src]
  321.     if {[string first "." $src] == -1 || ![isLegalDiagType $diagType]} {
  322.         # src is a class
  323.         lappend sources $src
  324.         continue
  325.     }
  326.  
  327.     # src is a diagram
  328.     set diagName [nt_get_name $src]
  329.     if {$diagType == "cdm"} {
  330.         # src refers to a class after all
  331.         lappend sources $diagName
  332.         continue
  333.     }
  334.     
  335.     if {$diagType == "cod"} {
  336.         lappend codNames $diagName
  337.     } elseif {$diagType == "ccd" || $diagType == "etd" || $diagType == "std"} {
  338.         # remember which kinds of events are needed
  339.         lappend eventTypes $diagType
  340.         #
  341.         # remember if just one event diagram is specified; if so,
  342.         # we only check events in that diagram
  343.         $this eventDiagram $src
  344.     } elseif {$diagType != "cad"} {
  345.         m4_message $M_CANNOT_CHECK_DIAG_TYPE $diagName $diagType
  346.         continue
  347.     }
  348.  
  349.     # add the src/diagram to sources
  350.     lappend sources $src
  351.     }
  352.  
  353.     # if more than 1 class/diagram specified then clear this eventDiagram,
  354.     # unconditionally
  355.     #
  356.     if {$srcCount != 1} {
  357.     $this eventDiagram ""
  358.     }
  359.  
  360.     #
  361.     # If no event diagrams specified or doing global checking,
  362.     # get events sent in any diagram
  363.     #
  364.     if {[lempty $eventTypes] || $global} {
  365.     set eventTypes {ccd etd std}
  366.     }
  367.  
  368.     #
  369.     # Check(s) needing specific types of events to be loaded.
  370.     #
  371.     if {[M4CheckManager::errorControl $E_NO_CORR_CCDMSG_FOUND] != "off"} {
  372.     lappend eventTypes ccd
  373.     }
  374.  
  375.     $this srcCount $srcCount
  376.     $this sources [flatten $sources]
  377.     $this eventTypes [flatten $eventTypes]
  378.     $this codNames [flatten $codNames]
  379. }
  380.  
  381. method ModelChecker::parseOptions {this} {
  382.     #
  383.     # See if any boolean options were specified, set the appropriate
  384.     # variables, and remove any options from argv.
  385.     #
  386.     global booleanOptions argv
  387.  
  388.     foreach opt $booleanOptions {
  389.         set i [lsearch $argv [lindex $opt 0]]
  390.     set optvar [lindex $opt 1]
  391.     eval "global $optvar"
  392.         if {$i == -1} {
  393.             set optdef [lindex $opt 2]
  394.             eval "set $optvar $optdef"
  395.         } else {
  396.         set argv [lreplace $argv $i $i]
  397.             eval "set $optvar 1"
  398.         }
  399.     }
  400. }
  401.  
  402. method ModelChecker::setCheckStatus {this diagName {newStatus ""}} {
  403.     #
  404.     # Set check status for specified diagram
  405.     #
  406.     set fileName [nt_get_name $diagName]
  407.     set fileType [nt_get_type $diagName]
  408.  
  409.     if {$fileName == "" || $fileType == ""} {
  410.     puts stderr "ERROR: ModelChecker::setCheckStatus: filename '$diagName' not of format 'diagram.type'"
  411.     return 0
  412.     }
  413.  
  414.     set cc [ClientContext::global]
  415.     set sysV [$cc currentSystem]
  416.     set fileV [$sysV findFileVersion $fileName $fileType]
  417.     if {[$fileV isNil]} {
  418.     #
  419.     # Exceptional case: A.B.cdm
  420.     #
  421.     set fileV [$sysV findFileVersion $fileName.$fileType cdm]
  422.     if {[$fileV isNil]} {
  423.         puts stderr "ERROR: ModelChecker::setCheckStatus: '$diagName': no such fileVersion"
  424.         return 0
  425.     }
  426.     }
  427.  
  428.     switch -exact -- "$newStatus" {
  429.     ""      -
  430.     reset   { set status "not checked" }
  431.     ok      { set status "checked OK" }
  432.     failed  { set status "checked with errors" }
  433.     default { puts stderr "ERROR: ModelChecker::setCheckStatus: '$newStatus': bad status; should be one of \[reset|ok|failed]" ; return 0 }
  434.     }
  435.  
  436. if 0 {
  437.     #
  438.     # Cannot set property while diagram is locked ...
  439.     #
  440.     if {[catch {$fileV setProperty check_status "$status"} reason]} {
  441.     # for now, ignore failure message...
  442.     #m4_warning $W_CHECK_STATUS "$status"
  443.     #puts stderr "WARNING: Unable to set property 'check_status' to value '$status'"
  444.     #puts stderr $reason
  445.     return 0
  446.     }
  447. }  # 0
  448.  
  449.     return 1
  450. }
  451.  
  452. method ModelChecker::getSelectedOoplClasses {this} {
  453.     #
  454.     # Return the set of oopl classes, selected by this sources and this
  455.     # exclClassFilter
  456.     # If this sources == {} then the global model is loaded, else a local
  457.     # model is loaded
  458.     # this exclClassFilter is always applied
  459.     #
  460.  
  461.     # determine sources from this sources
  462.     #
  463.     set sources [$this sources]
  464.     if {$sources == {}} {
  465.     # global model: let sources be all classes of the oopl model
  466.     foreach class [[$this ooplModel] getClassNames] {
  467.         if {[lsearch $sources $class] == -1} {
  468.         lappend sources $class
  469.         }
  470.     }
  471.     }
  472.  
  473.     # determine classes from sources
  474.     #
  475.     set classes [$this getSourceClasses $sources]
  476.  
  477.     # apply this exclClassFilter to classes, if needed
  478.     #
  479.     if {[$this exclClassFilter] != {}} {
  480.     #
  481.     # determine classes from this exclClassFilter
  482.     #
  483.     foreach class [$this getSourceClasses [$this exclClassFilter]] {
  484.         set idx [lsearch $classes $class]
  485.         if {$idx != -1} {
  486.         # delete class from classes
  487.         set classes [lreplace $classes $idx $idx]
  488.         }
  489.     }
  490.     }
  491.  
  492.     # determine oopl classes
  493.     #
  494.     set ooplClasses {}
  495.     foreach class $classes {
  496.     if {$class == ""} {
  497.         puts stderr "Skipping class without name"
  498.         continue
  499.     }
  500.  
  501.     set ooplClass [[$this ooplModel] classByName $class]
  502.     if {$ooplClass == ""} {
  503.         puts stderr "Unable to load class '$class'"
  504.         continue
  505.     }
  506.  
  507.     if {[lsearch $ooplClasses $ooplClass] == -1} {
  508.         lappend ooplClasses $ooplClass
  509.     }
  510.     }
  511.  
  512.     return $ooplClasses
  513. }
  514.  
  515. method ModelChecker::getSelectedOoplSubjects {this} {
  516.     #
  517.     # Return the set of oopl subjects, selected by the CCD's in this sources
  518.     # If nothing has been selected, then return all subjects present in the
  519.     # oopl model
  520.     #
  521.     if {[$this sources] == {}} {
  522.     return [[$this ooplModel] subjectSet]
  523.     }
  524.  
  525.     set subjects {}
  526.     foreach source [$this sources] {
  527.     if {[nt_get_type $source] == "ccd"} {
  528.         lappend subjects [get_diagram_subjects $source]
  529.     }
  530.     }
  531.  
  532.     #
  533.     # select those oopl subjects with their name present in subjects
  534.     #
  535.     set ooplSubjects {}
  536.     foreach subject [[$this ooplModel] subjectSet] {
  537.     if {[lsearch $subjects [$subject getName]] != -1} {
  538.         lappend ooplSubjects $subject
  539.     }
  540.     }
  541.  
  542.     return $ooplSubjects
  543. }
  544.  
  545. method ModelChecker::getSourceClasses {this sources} {
  546.     #
  547.     # Return the set of classes belonging to 'sources'
  548.     # A source may be the name of one of:
  549.     #    - class
  550.     #    - diagram, may contain classes and/or be qualified by a class
  551.     #
  552.     set classes {}
  553.     foreach source $sources {
  554.     if {[string first "." $source] == -1} {
  555.         # it is a class; add it
  556.         if {[lsearch $classes $source] == -1} {
  557.         lappend classes $source
  558.         }
  559.         continue
  560.     }
  561.  
  562.     # it is a diagram; add all classes in the diagram
  563.     foreach class [get_diagram_classes $source] {
  564.         if {[lsearch $classes $class] == -1} {
  565.         lappend classes $class
  566.         }
  567.     }
  568.  
  569.     set diagType [nt_get_type $source]
  570.     if {$diagType == "etd" || $diagType == "std"} {
  571.         #
  572.         # the diagram is qualified by a class; add the class
  573.         #
  574.         set diagName [nt_get_name $source]
  575.         set class [lindex [split $diagName '/'] 0]
  576.         if {[lsearch $classes $class] == -1} {
  577.         lappend classes $class
  578.         }
  579.     }
  580.     }
  581.  
  582.     return $classes
  583. }
  584.  
  585. # Do not delete this line -- regeneration end marker
  586.  
  587.