home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / langcheck.tcl < prev    next >
Text File  |  1997-10-20  |  4KB  |  128 lines
  1. ###########################################################################
  2. ##
  3. ##  Copyright (c) 1996 by Cadre Technologies Inc.
  4. ##                          and Scientific Toolworks Inc.
  5. ##
  6. ##  This software is furnished under a license and may be used only in
  7. ##  accordance with the terms of such license and with the inclusion of
  8. ##  the above copyright notice. This software or any other copies thereof
  9. ##  may not be provided or otherwise made available to any other person.
  10. ##  No title to and ownership of the software is hereby transferred.
  11. ##
  12. ##  The information in this software is subject to change without notice
  13. ##  and should not be construed as a commitment by Cadre Technologies Inc.
  14. ##  or Scientific Toolworks Inc.
  15. ##
  16. ###########################################################################
  17.  
  18. puts "\nAda83 Diagram Checker"
  19.  
  20. require a83genmsg.tcl
  21.  
  22. source [m4_path_name tcl ada_funcs.tcl]
  23.  
  24. #
  25. # miscellaneous utility procedures:
  26. #
  27.  
  28.  
  29. proc ada_notes {notes_txt} {
  30.     m4_fmt_message "NOTES: (Ada) $notes_txt\n"
  31. }
  32.  
  33. #
  34. # method CMCmnClass::checkClassAttributes
  35. #
  36.  
  37. rename CMCmnClass::checkClassAttributes CMCmnClass::orgCheckClassAttributes
  38. method CMCmnClass::checkClassAttributes {this} {
  39.     CMCmnClass::orgCheckClassAttributes $this
  40.     set dataAttribs [$this findDataAttrs 1]
  41.     foreach attrib $dataAttribs {
  42.        set access [get_attrib_access $attrib]
  43.        if {"$access" != "" && "$access" != "Public-Public"} {
  44.        set class_visibility [get_class_visibility $this]
  45.        if {"$class_visibility" == "" || "$class_visibility" == "Public"} {
  46.           m4_error $E_PUBCLASSPRIVATTR [get_name $this] [get_name $attrib] [get_attrib_access $attrib]
  47.            }
  48.        }
  49.     }
  50.     set assocAttribs [$this findAssocAttrs 1]
  51.     foreach attrib $assocAttribs {
  52.        set access [get_attrib_access $attrib]
  53.        if {"$access" != "" && "$access" != "Public-Public"} {
  54.          set class_visibility [get_class_visibility $this]
  55.         if {"$class_visibility" == "" || "$class_visibility" == "Public"} {
  56.            m4_error $E_PUBCLASSPRIVASSOC [get_name $this] [get_name $attrib] [get_attrib_access $attrib]
  57.         }
  58.        }
  59.        if {[get_opposite $attrib] != ""} {
  60.         set type [get_type $attrib]
  61.         if {[get_class_visibility $this] != "Opaque" || \
  62.                [get_class_visibility $type]  != "Opaque"} {
  63.         m4_error $E_BIDIRASSOC [get_name $this] [get_name $type]
  64.         }
  65.        }
  66.     }
  67. }
  68.  
  69. #
  70. # Redefine method CMCmnClass::checkClassOperations
  71. #
  72. rename CMCmnClass::checkClassOperations CMCmnClass::orgCheckClassOperations
  73. method CMCmnClass::checkClassOperations {this} {
  74.     CMCmnClass::orgCheckClassOperations {this}
  75.     set opers [$this operationSet]
  76.     foreach oper $opers {
  77.        set name [get_name $oper]
  78.        if {[is_oper $name]} {
  79.       set type [get_type $oper]
  80.       if {[get_name $type] == ""} {
  81.          m4_error $E_OPERNORETTYPE $name [get_name $this]
  82.           }
  83.        }
  84.     }
  85. }
  86.  
  87.  
  88. #
  89. # method CMParamter::mcheck {this oper class}
  90. #
  91.  
  92. rename CMParameter::mcheck CMParameter::orgMcheck 
  93. method CMParameter::mcheck {this oper class} {
  94.     CMParameter::orgMcheck $this $oper $class
  95.     set type [get_type $oper]
  96.     if {[get_name $type] != ""} {
  97.     if {[get_param_dfd $this] != "" && [get_param_dfd $this] != "in"} {
  98.         m4_error $E_OPERPARAMNOTIN [get_name $this] [get_name $oper] [get_name $type]
  99.     }
  100.     }
  101. }
  102.  
  103. #
  104. # redefined procedures from product-tcl/check_conf.tcl:
  105. #
  106.  
  107. #
  108. # procedure add_predefined_methods
  109. #
  110.  
  111. proc add_predefined_methods {ooplmodel} {
  112.     #
  113.     # Call user-supplied function to add methods
  114.     #
  115.     if {[info procs add_user_defined_methods] != ""} {
  116.         add_user_defined_methods $ooplmodel
  117.     }
  118. }
  119.  
  120. #
  121. # redefine method CDMDataAttr::prepare
  122. #
  123.  
  124. method CMDataAttr::prepare {this class model forwhat} {
  125. }
  126.  
  127.  
  128.