note description: "Visitor to check accessors for a given feature" legal: "See notice at end of class." status: "See notice at end of class." date: "$Date$" revision: "$Revision$" class EB_ACCESSED_FEATURE_VISITOR inherit AST_ITERATOR export {NONE} all redefine process_access_feat_as, process_access_assert_as, process_routine_creation_as, process_tagged_as, process_binary_as, process_unary_as, process_static_access_as, process_bracket_as, process_like_id_as, process_assign_as, process_creation_as, process_interval_as end QL_UTILITY QL_SHARED SHARED_TEXT_ITEMS INTERNAL_COMPILER_STRING_EXPORTER create make feature{NONE} -- Initialization make -- Initialize Current. do create accessors.make (5) create flag_stack.make create ancestor_class_id_set.make (20) end feature -- Access accessors: ARRAYED_LIST [TUPLE [AST_EIFFEL, CLASS_C]] -- Accessors found by last `find_accessors' -- The TUPLE is in form of [accessor AST, accessor written class] flag: NATURAL_16 -- Required flag to match certain kinds of accessors such as assigner, creator.. feature -- Setting set_flag (a_flag: like flag) -- Set `flag' with `a_flag'. do flag := a_flag ensure flag_set: flag = a_flag end feature -- Process find_accessors (a_callee: QL_FEATURE; a_caller: QL_FEATURE) -- Find `a_callee' from `a_caller' and store results in `accessors'. require a_callee_attached: a_callee /= Void a_caller_attached: a_caller /= Void do flag_stack.wipe_out accessors.wipe_out ancestor_class_id_set.wipe_out if a_callee.is_real_feature then e_feature := a_callee.e_feature set_last_class_c (a_caller.class_c) ancestor_class_id_set.put (e_feature.associated_class.class_id) -- Check feature body. if a_caller.is_real_feature then -- For real features a_caller.ast.process (Current) else -- For immediate class invariants check_accessor_for_assertions (a_caller.wrapped_domain, True) end -- Retrieve all inherited assertions and check those assertions. setup_ancestor_class_id_table (e_feature.associated_class) check_accessor_for_assertions (a_caller.wrapped_domain, False) end end setup_ancestor_class_id_table (a_class_c: CLASS_C) -- Setup `ancestor_class_id_set' with ancestors of `a_class_c'. require a_class_c_attached: a_class_c /= Void local l_table: like ancestor_class_id_set l_ancestors: QL_CLASS_DOMAIN l_class_generator: QL_CLASS_DOMAIN_GENERATOR do -- Retrieve ancestor classes for associated class of `a_class_c'. create l_class_generator.make ( create {QL_CLASS_ANCESTOR_RELATION_CRI}.make ( query_class_item_from_class_c (a_class_c).wrapped_domain, {QL_CLASS_ANCESTOR_RELATION_CRI}.ancestor_type), True) l_class_generator.enable_optimization l_ancestors ?= system_target_domain.new_domain (l_class_generator) -- Setup `ancestor_class_id_table'. if l_ancestors /= Void and then not l_ancestors.is_empty then from l_table := ancestor_class_id_set l_ancestors.start until l_ancestors.after loop l_table.force (l_ancestors.item.class_c.class_id) l_ancestors.forth end end end feature{NONE} -- Implementation e_feature: E_FEATURE -- Eiffel feature whose accessors are to be found is_accessor (a_feature: E_FEATURE; a_class_id: INTEGER; a_feature_name: STRING): BOOLEAN -- Is feature named `a_feature_name' whose associated class id is `a_class_id' a accessor of `a_feature'? require a_feature_attached: a_feature /= Void a_feature_name_attached: a_feature_name /= Void not_a_feature_name_is_empty: not a_feature_name.is_empty do if ancestor_class_id_set.has (a_class_id) then Result := a_feature_name.is_case_insensitive_equal (a_feature.name) or else a_feature_name.is_case_insensitive_equal (ti_Precursor_keyword) if not Result and then a_feature.has_alias_name then Result := a_feature.has_alias_named (a_feature_name) end if Result then Result := flag /= 0 implies flag_stack.has (flag) end end end ancestor_class_id_set: DS_HASH_SET [INTEGER] -- Class id set of ancestors of associated class of `e_feature' last_class_c: CLASS_C -- Last processed class feature -- Accessor checking check_accessor (a_feature: like e_feature; l_as: ACCESS_FEAT_AS) -- Check if `l_as' is an accessor of `a_feature'. -- If it is, store `l_as' into `accessors'. require a_feature_attached: a_feature /= Void do if is_accessor (a_feature, l_as.class_id, l_as.access_name) then check last_class_c /= Void end accessors.extend ([l_as.feature_name, last_class_c]) end end check_accessor_for_routine_creation (l_as: ROUTINE_CREATION_AS) -- Check if `l_as' accesses `e_feature'. -- If it is, store `l_as' into `accessors'. do -- Watch out since `feature_name' from ROUTINE_CREATION_AS can be Void in -- the case of an inline agent. if l_as.feature_name /= Void and then is_accessor (e_feature, l_as.class_id, l_as.feature_name.name) then check last_class_c /= Void end accessors.extend ([l_as.feature_name, last_class_c]) end end check_accessor_for_operators (a_feature: like e_feature; a_class_id: INTEGER; a_feature_name: STRING; a_ast: AST_EIFFEL) -- Process binary or unary operators associated with class id `a_class_id', name `a_feature_name'. -- `a_ast' is the AST node for that operator. require a_feature_attached: a_feature /= Void a_class_id_positive: a_class_id > 0 a_feature_name_attached: a_feature_name /= Void a_ast_attached: a_ast /= Void do if is_accessor (a_feature, a_class_id, a_feature_name) then check last_class_c /= Void end accessors.extend ([a_ast, last_class_c]) end end check_accessor_for_assertions (a_source_domain: QL_DOMAIN; a_immediate: BOOLEAN) -- Check accessors in assertions from `a_source_domain'. -- `a_immediate' indicates if assertions should be immediate or not. require a_source_domain_attached: a_source_domain /= Void local l_assertion_cri: QL_ASSERTION_CRITERION l_assertion_domain: QL_ASSERTION_DOMAIN do l_assertion_cri := assertion_criterion_factory.criterion_with_name (query_language_names.ql_cri_is_immediate, []) if not a_immediate then l_assertion_cri := not l_assertion_cri end l_assertion_domain ?= a_source_domain.new_domain (create {QL_ASSERTION_DOMAIN_GENERATOR}.make (l_assertion_cri, True)) if l_assertion_domain /= Void and then not l_assertion_domain.is_empty then l_assertion_domain.do_all (agent process_assertion) end end feature{NONE} -- Implementation/Process process_access_feat_as (l_as: ACCESS_FEAT_AS) do check_accessor (e_feature, l_as) Precursor (l_as) end process_access_assert_as (l_as: ACCESS_ASSERT_AS) local l_feature: like e_feature l_ancestor_feature: like e_feature do l_feature := e_feature -- For renamed features in inherited assertions if l_as.class_id /= l_feature.associated_class.class_id then l_ancestor_feature := ancestor_version_with_different_name (l_feature, l_as.class_id) if l_ancestor_feature /= Void then check_accessor (l_ancestor_feature, l_as) end end Precursor (l_as) end process_assertion (a_assertion: QL_ASSERTION) -- Process `a_assertion'. require a_assertion_attached: a_assertion /= Void do set_last_class_c (a_assertion.written_class) a_assertion.ast.process (Current) end process_routine_creation_as (l_as: ROUTINE_CREATION_AS) do check_accessor_for_routine_creation (l_as) Precursor (l_as) end process_tagged_as (l_as: TAGGED_AS) do if attached l_as.expr as e then e.process (Current) end end process_binary_as (l_as: BINARY_AS) do check_accessor_for_operators (e_feature, l_as.class_id, l_as.operator_name, l_as.operator_ast) Precursor (l_as) end process_unary_as (l_as: UNARY_AS) do check_accessor_for_operators (e_feature, l_as.class_id, l_as.operator_name, l_as.operator_ast) Precursor (l_as) end process_static_access_as (l_as: STATIC_ACCESS_AS) do check_accessor (e_feature, l_as) Precursor (l_as) end process_bracket_as (l_as: BRACKET_AS) do check_accessor_for_operators (e_feature, l_as.class_id, "[]", l_as) Precursor (l_as) end process_like_id_as (l_as: LIKE_ID_AS) local l_ancestor_feature: E_FEATURE l_old_last_class_c: CLASS_C l_e_feature_associated_class_id: INTEGER l_e_feature_written_class_id: INTEGER l_e_feature: like e_feature do l_e_feature := e_feature l_e_feature_associated_class_id := l_e_feature.associated_class.class_id l_e_feature_written_class_id := l_e_feature.written_class.class_id -- For renamed feature if l_e_feature_associated_class_id /= l_e_feature_written_class_id then l_ancestor_feature := ancestor_version_with_different_name (l_e_feature, l_e_feature_written_class_id) if l_ancestor_feature /= Void then l_old_last_class_c := last_class_c set_last_class_c (l_ancestor_feature.associated_class) check_accessor_for_operators (l_ancestor_feature, l_e_feature_associated_class_id, l_as.anchor.name, l_as.anchor) set_last_class_c (l_old_last_class_c) end end check_accessor_for_operators (l_e_feature, l_e_feature_associated_class_id, l_as.anchor.name, l_as.anchor) end process_assign_as (l_as: ASSIGN_AS) local l_flag_stack: like flag_stack do l_flag_stack := flag_stack l_flag_stack.extend ({DEPEND_UNIT}.is_in_assignment_flag) l_as.target.process (Current) l_flag_stack.remove l_as.source.process (Current) end process_creation_as (l_as: CREATION_AS) local l_flag_stack: like flag_stack do l_flag_stack := flag_stack l_flag_stack.extend ({DEPEND_UNIT}.is_in_creation_flag) l_as.target.process (Current) l_flag_stack.remove safe_process (l_as.type) safe_process (l_as.call) end process_interval_as (l_as: INTERVAL_AS) local l_atom: ATOMIC_AS do Precursor (l_as) l_atom := l_as.lower if l_atom.is_id and then is_accessor (e_feature, last_class_c.class_id, l_atom.string_value) then accessors.extend ([l_atom, last_class_c]) end l_atom := l_as.upper if attached l_atom and then is_accessor (e_feature, last_class_c.class_id, l_atom.string_value) then accessors.extend ([l_atom, last_class_c]) end end feature{NONE} -- Implementation flag_stack: LINKED_STACK [like flag] -- Stack of flags set_last_class_c (a_class: like last_class_c) -- Set `last_class_c' with `a_class'. do last_class_c := a_class ensure last_class_c_set: last_class_c = a_class end ancestor_version_with_different_name (a_feature: E_FEATURE; a_class_id: INTEGER): detachable E_FEATURE -- Ancestor feature (version from class whose id is `a_class_id') of `a_feature' with a different name. require a_feature_attached: a_feature /= Void local l_retried: BOOLEAN do -- Fixme: This protection is to avoid a strange crash when invoking `ancestor_version' on `a_feature'. -- Try to find the real reason later. if not l_retried and then attached system.class_of_id (a_class_id) as l_class then Result := a_feature.ancestor_version (l_class) if attached Result and then Result.name.is_case_insensitive_equal (a_feature.name) and then ((not Result.has_alias_name) and then (not a_feature.has_alias_name)) then Result := Void end end rescue l_retried := True retry end invariant accessors_attached: accessors /= Void ancestor_class_id_set_attached: ancestor_class_id_set /= Void note copyright: "Copyright (c) 1984-2021, Eiffel Software" license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)" licensing_options: "http://www.eiffel.com/licensing" copying: "[ This file is part of Eiffel Software's Eiffel Development Environment. Eiffel Software's Eiffel Development Environment 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, version 2 of the License (available at the URL listed under "license" above). Eiffel Software's Eiffel Development Environment 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 Eiffel Software's Eiffel Development Environment; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ]" source: "[ Eiffel Software 5949 Hollister Ave., Goleta, CA 93117 USA Telephone 805-685-1006, Fax 805-685-6869 Website http://www.eiffel.com Customer support http://support.eiffel.com ]" end