note
	description: "Class providing base implementation for {ETEST} creation sessions."
	date: "$Date$"
	revision: "$Revision$"

deferred class
	ETEST_CREATION

inherit
	TEST_CREATION
		rename
			make as make_creation
		end

feature {NONE} -- Initialization

	make (a_test_suite: like test_suite; a_etest_suite: like etest_suite; a_is_gui: BOOLEAN)
			-- Initialize `Current'.
			--
			-- `a_test_suite': {TEST_SUITE_S} instance.
			-- `a_etest_suite': {ETEST_SUITE} instance.
		require
			a_test_suite_attached: a_test_suite /= Void
			a_etest_suite_attached: a_etest_suite /= Void
			a_test_suite_usable: a_test_suite.is_interface_usable
		do
			make_creation (a_test_suite, a_is_gui)
			etest_suite := a_etest_suite
			create path.make_empty
			class_name := default_class_name
			create internal_tags.make (10)
		ensure
			test_suite_set: test_suite = a_test_suite
			etest_suite_set: etest_suite = a_etest_suite
		end

feature -- Access

	cluster: detachable CONF_CLUSTER
			-- Cluster in which new tests will be created.
			--
			-- Note: we do not store the cluster object directly since that might change after compiling.
		do
			Result := etest_suite.project_access.project.universe.cluster_of_name (cluster_name)
		end

	path: PATH
			-- Additional path in `cluster' where tests will be created.
			--
			-- Note: by default empty.

	class_name: IMMUTABLE_STRING_8
			-- Name of new test class.
			--
			-- Note: is used as prefix if `creates_multiple_classes' is True.

	tags: ARRAYED_LIST [READABLE_STRING_32]
			-- Tags with which new test routine(s) are tagged.
		do
			Result := internal_tags.linear_representation
		end

feature {NONE} -- Access

	etest_suite: ETEST_SUITE
			-- Test suite containing project information

	class_name_counter: NATURAL
			-- Counter used by `create_new_class' to generate class names

	cluster_name: detachable STRING
			-- Optional name of cluster and path where new tests should be created

	internal_tags: TAG_SEARCH_TABLE
			-- Internal storage for `tags'

feature {NONE} -- Status report

	creates_multiple_classes: BOOLEAN
			-- Does current create multiple new test classes during one creation?
		deferred
		end

feature {TEST_SUITE_S} -- Status setting

	frozen start
			-- <Precursor>
		do
			class_name_counter := 1
			start_creation
		end

feature -- Status setting

	set_cluster_name (a_name: READABLE_STRING_8)
			-- Set `cluster_name' to given name.
			--
			-- `a_name': Name of cluster in which new tests should be created.
		require
			a_name_attached: a_name /= Void
			not_running: not has_next_step
		do
			create cluster_name.make_from_string (a_name)
		ensure
			cluster_name_set: attached cluster_name as l_name and then l_name.same_string (a_name)
		end

	set_path_name (a_name: READABLE_STRING_GENERAL)
			-- Set `path_name' to given path.
			--
			-- `a_name': Name of new path.
		require
			a_name_attached: a_name /= Void
			not_running: not has_next_step
		do
			create path.make_from_string (a_name)
		end

	set_class_name (a_name: READABLE_STRING_8)
			-- Set `class_name' to given name.
			--
			-- `a_name': New name for `class_name'.
		require
			a_name_attached: a_name /= Void
			a_name_not_empty: not a_name.is_empty
			not_running: not has_next_step
		do
			create class_name.make_from_string (a_name)
		ensure
			class_name_set: class_name.same_string (a_name)
		end

	add_tag (a_tag: READABLE_STRING_32)
			-- Add given tag to `tags'.
		require
			a_tag_attached: a_tag /= Void
			a_tag_not_empty: not a_tag.is_empty
			not_running: not has_next_step
		do
			internal_tags.force (a_tag.twin)
		ensure
			added: tags.there_exists (agent {READABLE_STRING_32}.same_string (a_tag))
		end

feature {NONE} -- Status setting

	start_creation
			-- Start creation session.
		require
			usable: is_interface_usable
			not_running: not has_next_step
		deferred
		end

feature {NONE} -- Basic operations

	create_new_class
			-- Create a new class according to `configuration'.
		require
			usable: is_interface_usable
			running: has_next_step
		local
			l_cluster: like cluster
			l_location: like {PROJECT_DIRECTORY}.path
			l_directory: DIRECTORY
			l_file: KL_TEXT_OUTPUT_FILE_32
			l_filename: STRING_32
			l_class_name: STRING_32
			l_retry: BOOLEAN
		do
			l_cluster := cluster
			if l_cluster = Void then
				error_event.publish ([Current, locale.translation ("No cluster was specified to create the class into.")])
			else
				l_location := l_cluster.location.build_path (path.name, "")
				create l_directory.make_with_path (l_location)
				if not l_directory.exists then
					l_directory.recursive_create_dir
				end

				if not l_directory.exists then
					error_event.publish ([Current, locale.formatted_string (e_directory_does_not_exist, [l_location])])
				elseif not l_directory.is_writable then
					error_event.publish ([Current, locale.formatted_string (e_directory_not_writable, [l_location])])
				else
					from until
						l_file /= Void
					loop
						l_class_name := class_name
						l_class_name.to_lower
						if creates_multiple_classes or l_retry then
							create l_filename.make (l_class_name.count + 6)
							l_filename.append (l_class_name)
							l_filename.append_character ('_')
							if class_name_counter < 10 then
								l_filename.append ("00")
							elseif class_name_counter < 100 then
								l_filename.append ("0")
							end
							l_filename.append_natural_32 (class_name_counter)
						else
							l_filename := l_class_name
						end
						l_filename.append (".e")
						create l_file.make_with_path (l_location.extended (l_filename))
						if l_file.exists then
							class_name_counter := class_name_counter + 1
							if class_name_counter <= 999 then
								l_file := Void
							end
						end
						l_retry := True
					end

					if not l_file.exists then
						l_file.open_write
						if l_file.is_open_write then
							l_class_name := l_filename.substring (1, l_filename.count - 2)
							check l_class_name /= Void end
							l_class_name.to_upper
							print_new_class (l_file, l_class_name)
							if l_file.is_open_write then
								l_file.close
							end
							if l_cluster /= Void and then l_file.exists and then l_file.count > 0 then
								-- Only perform quick melt when creating a single manual test
								-- and when the previous compilation was successful.
								etest_suite.project_helper.add_class (
									l_cluster,
									path,
									create {PATH}.make_from_string (l_filename),
									l_class_name,
									attached {ETEST_MANUAL_CREATION} Current and then etest_suite.project_access.project.successful
								)
							elseif etest_suite.eiffel_project.system_defined then
								etest_suite.project_access.project.system.system.rebuild_configuration
							end
								-- TODO: add new (uncompiled) tests to {ETEST_SUITE}
						else
							error_event.publish ([Current, locale.formatted_string (e_file_not_creatable, [l_location, l_filename])])
						end
					else
						error_event.publish ([Current, locale.formatted_string (e_file_already_exists, [l_location, l_filename])])
					end
				end
			end
		end

	print_new_class (a_file: KL_TEXT_OUTPUT_FILE_32; a_class_name: READABLE_STRING_32)
			-- Print new class text to `a_file'.
		require
			a_file_attached: a_file /= Void
			a_class_name_attached: a_class_name /= Void
			usable: is_interface_usable
			running: has_next_step
			a_class_name_not_empty: not a_class_name.is_empty
			a_file_open_write: a_file.is_open_write
		deferred
		end

feature {NONE} -- Constants

	default_class_name: STRING = "TEST_"

feature {NONE} -- Internationalization

	e_can_not_create_new_class_file: STRING = "Can not create new class file in $1:%N%N"
	e_directory_does_not_exist: STRING
		do
			Result := e_can_not_create_new_class_file.twin
			Result.append ("Path does not exist.")
		end
	e_directory_not_writable: STRING
		do
			Result := e_can_not_create_new_class_file.twin
			Result.append ("Path is not writable.")
		end
	e_file_already_exists: STRING
		do
			Result := e_can_not_create_new_class_file.twin
			Result.append ("File $2 already exists.")
		end
	e_file_not_creatable: STRING
		do
			Result := e_can_not_create_new_class_file.twin
			Result.append ("Unable to create file $2.")
		end

invariant
	class_name_not_empty: not class_name.is_empty

note
	copyright: "Copyright (c) 1984-2019, 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