From eedc41435ba29c010aadbd6877013cd77b495aae Mon Sep 17 00:00:00 2001 From: Emmanuel Briot Date: Mon, 3 Feb 2014 16:01:23 +0100 Subject: [PATCH] Initial revision --- .gitignore | 6 + docs/Makefile | 153 ++++++++++++++++++ docs/_static/.gitignore | 0 docs/_templates/.gitignore | 0 docs/bdd.rst | 79 ++++++++++ docs/conf.py | 285 ++++++++++++++++++++++++++++++++++ docs/index.rst | 23 +++ docs/output.rst | 17 ++ gnatbdd.gpr | 12 ++ src/colors.c | 30 ++++ src/driver.adb | 11 ++ src/gnatcoll-terminal.adb | 307 +++++++++++++++++++++++++++++++++++++ src/gnatcoll-terminal.ads | 133 ++++++++++++++++ src/gnattdd-features.adb | 0 src/gnattdd-features.ads | 15 ++ src/gnattdd-main.adb | 9 ++ src/gnattdd.ads | 2 + src/test_colors.adb | 56 +++++++ 18 files changed, 1138 insertions(+) create mode 100644 .gitignore create mode 100644 docs/Makefile create mode 100644 docs/_static/.gitignore create mode 100644 docs/_templates/.gitignore create mode 100644 docs/bdd.rst create mode 100644 docs/conf.py create mode 100644 docs/index.rst create mode 100644 docs/output.rst create mode 100644 gnatbdd.gpr create mode 100644 src/colors.c create mode 100644 src/driver.adb create mode 100644 src/gnatcoll-terminal.adb create mode 100644 src/gnatcoll-terminal.ads create mode 100644 src/gnattdd-features.adb create mode 100644 src/gnattdd-features.ads create mode 100644 src/gnattdd-main.adb create mode 100644 src/gnattdd.ads create mode 100644 src/test_colors.adb diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..655866b --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +docs/_build +obj/ +b__* +*.ali +*.d +*.a diff --git a/docs/Makefile b/docs/Makefile new file mode 100644 index 0000000..5168ba6 --- /dev/null +++ b/docs/Makefile @@ -0,0 +1,153 @@ +# Makefile for Sphinx documentation +# + +# You can set these variables from the command line. +SPHINXOPTS = +SPHINXBUILD = sphinx-build +PAPER = +BUILDDIR = _build + +# Internal variables. +PAPEROPT_a4 = -D latex_paper_size=a4 +PAPEROPT_letter = -D latex_paper_size=letter +ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) . +# the i18n builder cannot share the environment and doctrees with the others +I18NSPHINXOPTS = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) . + +.PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest gettext + +help: + @echo "Please use \`make ' where is one of" + @echo " html to make standalone HTML files" + @echo " dirhtml to make HTML files named index.html in directories" + @echo " singlehtml to make a single large HTML file" + @echo " pickle to make pickle files" + @echo " json to make JSON files" + @echo " htmlhelp to make HTML files and a HTML help project" + @echo " qthelp to make HTML files and a qthelp project" + @echo " devhelp to make HTML files and a Devhelp project" + @echo " epub to make an epub" + @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter" + @echo " latexpdf to make LaTeX files and run them through pdflatex" + @echo " text to make text files" + @echo " man to make manual pages" + @echo " texinfo to make Texinfo files" + @echo " info to make Texinfo files and run them through makeinfo" + @echo " gettext to make PO message catalogs" + @echo " changes to make an overview of all changed/added/deprecated items" + @echo " linkcheck to check all external links for integrity" + @echo " doctest to run all doctests embedded in the documentation (if enabled)" + +clean: + -rm -rf $(BUILDDIR)/* + +html: + $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html + @echo + @echo "Build finished. The HTML pages are in $(BUILDDIR)/html." + +dirhtml: + $(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml + @echo + @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml." + +singlehtml: + $(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml + @echo + @echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml." + +pickle: + $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle + @echo + @echo "Build finished; now you can process the pickle files." + +json: + $(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json + @echo + @echo "Build finished; now you can process the JSON files." + +htmlhelp: + $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp + @echo + @echo "Build finished; now you can run HTML Help Workshop with the" \ + ".hhp project file in $(BUILDDIR)/htmlhelp." + +qthelp: + $(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp + @echo + @echo "Build finished; now you can run "qcollectiongenerator" with the" \ + ".qhcp project file in $(BUILDDIR)/qthelp, like this:" + @echo "# qcollectiongenerator $(BUILDDIR)/qthelp/GNATTestDrivenDevelopment.qhcp" + @echo "To view the help file:" + @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/GNATTestDrivenDevelopment.qhc" + +devhelp: + $(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp + @echo + @echo "Build finished." + @echo "To view the help file:" + @echo "# mkdir -p $$HOME/.local/share/devhelp/GNATTestDrivenDevelopment" + @echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/GNATTestDrivenDevelopment" + @echo "# devhelp" + +epub: + $(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub + @echo + @echo "Build finished. The epub file is in $(BUILDDIR)/epub." + +latex: + $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex + @echo + @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex." + @echo "Run \`make' in that directory to run these through (pdf)latex" \ + "(use \`make latexpdf' here to do that automatically)." + +latexpdf: + $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex + @echo "Running LaTeX files through pdflatex..." + $(MAKE) -C $(BUILDDIR)/latex all-pdf + @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex." + +text: + $(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text + @echo + @echo "Build finished. The text files are in $(BUILDDIR)/text." + +man: + $(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man + @echo + @echo "Build finished. The manual pages are in $(BUILDDIR)/man." + +texinfo: + $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo + @echo + @echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo." + @echo "Run \`make' in that directory to run these through makeinfo" \ + "(use \`make info' here to do that automatically)." + +info: + $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo + @echo "Running Texinfo files through makeinfo..." + make -C $(BUILDDIR)/texinfo info + @echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo." + +gettext: + $(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale + @echo + @echo "Build finished. The message catalogs are in $(BUILDDIR)/locale." + +changes: + $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes + @echo + @echo "The overview file is in $(BUILDDIR)/changes." + +linkcheck: + $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck + @echo + @echo "Link check complete; look for any errors in the above output " \ + "or in $(BUILDDIR)/linkcheck/output.txt." + +doctest: + $(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest + @echo "Testing of doctests in the sources finished, look at the " \ + "results in $(BUILDDIR)/doctest/output.txt." diff --git a/docs/_static/.gitignore b/docs/_static/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/docs/_templates/.gitignore b/docs/_templates/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/docs/bdd.rst b/docs/bdd.rst new file mode 100644 index 0000000..18b50e1 --- /dev/null +++ b/docs/bdd.rst @@ -0,0 +1,79 @@ +*************************** +Behavior Driven Development +*************************** + +Test Driven Developent (TDD) describes the cycle of writing a test first, and +application code afterwards. These tests could be unit tests, up to end-to-end +("black box") tests. TDD doesn't make any statements about what should be +tested, or how tests should be organized and named. + +An extension, Behavior Driven Development (BDD) has been suggested. Based on +various proposed templates, the user describes, in natural language, what an +application feature is intended to do, and various scenarios which the final +user might be applying. + +Basically, these natural language files answer three questions for each +scenario: + +* **In order** to get some benefit +* **As** the user you are developing for +* **I want** what this feature does + +This description is always followed by a list of scenarios containing **Given** +steps (what has happened before), **When** steps (what actions the user +performs), and **Then** steps (the desired outcome for the user). + +Testing an application +====================== + +BDD is not intended to replace unit tests. Instead, it is meant as a complement +to them. Unit tests (as written for instance with :program:`Aunit`, or +partially automatically generated with :program:`gnattest`) are white-box +testing, that apply to specific pieces of code. These are developer-level +tests, which are in general impossible to understand for potential users of the +application. + +BDD thus proposes to write the feature descriptions and their scenarios as +plain English tests in conjunction with the various stake holders. These +description are then processed automatically later on to test that the +application performs as expected. + +These tests are also different from the black-box testing that is often used, +when the application is run within a specific environment, and the output is +compared to an expected baseline. The intention in BDD is to be explicit in +*what* we are comparing in that output. Very often, the test is only intend +to check a very small part of the full output, and any variation in the rest +of the output is irrevant to the particular test we are running. + +Similar software +================ + +.. note:: + This section is for AdaCore internal use only + +There exist other similar software already. + +* :program:`cucumber` is a de-facto reference in the world of test-driven + development. + It is developed in Ruby, and provides quite a lot of facilities to test + web servers (preferably written in Ruby) and web clients. Adding new + step definitions needs to be done in Ruby, although there exists a number + of bridges to C++ and Java for instance. + Using it requires a Ruby setup on the developer's machine, and there is + no built-in support for writting tests in Ada. + +* :program:`Xreq` is a tool implemented by Sogilis, which has been used for + the testsuite of CRM, GNAT Tracker and bugtool for a while. This tool is + very close to :program:`cucumber`, and uses a similar syntax for the test + description files. + It has several drawbacks, though: its implementation is 'experimental', + and lacks documentation. Its output is sometimes confusing, and we made + several iterations to make it usable, although it could be improved. + This tool is not distributed outside of Sogilis and AdaCore, so it has not + been extensively tested either. + +* :program:`Fitnesse` uses tests written in a Wiki, and directly highlights + the web page to show passing and failing tests. + One of its nice aspects is that tests can be really mixed in with plain + English text for the requirements or design document. + diff --git a/docs/conf.py b/docs/conf.py new file mode 100644 index 0000000..00f400d --- /dev/null +++ b/docs/conf.py @@ -0,0 +1,285 @@ +# -*- coding: utf-8 -*- +# +# GNAT Test Driven Development documentation build configuration file, created by +# sphinx-quickstart on Mon Feb 3 10:18:55 2014. +# +# This file is execfile()d with the current directory set to its containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +import sys, os + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +#sys.path.insert(0, os.path.abspath('.')) + +# -- General configuration ----------------------------------------------------- + +# If your documentation needs a minimal Sphinx version, state it here. +#needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be extensions +# coming with Sphinx (named 'sphinx.ext.*') or your custom ones. +extensions = [] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix of source filenames. +source_suffix = '.rst' + +# The encoding of source files. +#source_encoding = 'utf-8-sig' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = u'GNAT Test Driven Development' +copyright = u'2014, AdaCore (c)' + +# The version info for the project you're documenting, acts as replacement for +# |version| and |release|, also used in various other places throughout the +# built documents. +# +# The short X.Y version. +version = '1.0' +# The full version, including alpha/beta/rc tags. +release = '1.0' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +#language = None + +# There are two options for replacing |today|: either, you set today to some +# non-false value, then it is used: +#today = '' +# Else, today_fmt is used as the format for a strftime call. +#today_fmt = '%B %d, %Y' + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +exclude_patterns = ['_build'] + +# The reST default role (used for this markup: `text`) to use for all documents. +#default_role = None + +# If true, '()' will be appended to :func: etc. cross-reference text. +#add_function_parentheses = True + +# If true, the current module name will be prepended to all description +# unit titles (such as .. function::). +#add_module_names = True + +# If true, sectionauthor and moduleauthor directives will be shown in the +# output. They are ignored by default. +#show_authors = False + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + +# A list of ignored prefixes for module index sorting. +#modindex_common_prefix = [] + + +# -- Options for HTML output --------------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +html_theme = 'default' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +#html_theme_options = {} + +# Add any paths that contain custom themes here, relative to this directory. +#html_theme_path = [] + +# The name for this set of Sphinx documents. If None, it defaults to +# " v documentation". +#html_title = None + +# A shorter title for the navigation bar. Default is the same as html_title. +#html_short_title = None + +# The name of an image file (relative to this directory) to place at the top +# of the sidebar. +#html_logo = None + +# The name of an image file (within the static path) to use as favicon of the +# docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32 +# pixels large. +#html_favicon = None + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# If not '', a 'Last updated on:' timestamp is inserted at every page bottom, +# using the given strftime format. +#html_last_updated_fmt = '%b %d, %Y' + +# If true, SmartyPants will be used to convert quotes and dashes to +# typographically correct entities. +#html_use_smartypants = True + +# Custom sidebar templates, maps document names to template names. +#html_sidebars = {} + +# Additional templates that should be rendered to pages, maps page names to +# template names. +#html_additional_pages = {} + +# If false, no module index is generated. +#html_domain_indices = True + +# If false, no index is generated. +#html_use_index = True + +# If true, the index is split into individual pages for each letter. +#html_split_index = False + +# If true, links to the reST sources are added to the pages. +#html_show_sourcelink = True + +# If true, "Created using Sphinx" is shown in the HTML footer. Default is True. +#html_show_sphinx = True + +# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True. +#html_show_copyright = True + +# If true, an OpenSearch description file will be output, and all pages will +# contain a tag referring to it. The value of this option must be the +# base URL from which the finished HTML is served. +#html_use_opensearch = '' + +# This is the file name suffix for HTML files (e.g. ".xhtml"). +#html_file_suffix = None + +# Output file base name for HTML help builder. +htmlhelp_basename = 'GNATTestDrivenDevelopmentdoc' + + +# -- Options for LaTeX output -------------------------------------------------- + +latex_elements = { +# The paper size ('letterpaper' or 'a4paper'). +#'papersize': 'letterpaper', + +# The font size ('10pt', '11pt' or '12pt'). +#'pointsize': '10pt', + +# Additional stuff for the LaTeX preamble. +#'preamble': '', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, author, documentclass [howto/manual]). +latex_documents = [ + ('index', 'GNATTestDrivenDevelopment.tex', u'GNAT Test Driven Development Documentation', + u'AdaCore (c)', 'manual'), +] + +# The name of an image file (relative to this directory) to place at the top of +# the title page. +#latex_logo = None + +# For "manual" documents, if this is true, then toplevel headings are parts, +# not chapters. +#latex_use_parts = False + +# If true, show page references after internal links. +#latex_show_pagerefs = False + +# If true, show URL addresses after external links. +#latex_show_urls = False + +# Documents to append as an appendix to all manuals. +#latex_appendices = [] + +# If false, no module index is generated. +#latex_domain_indices = True + + +# -- Options for manual page output -------------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + ('index', 'gnattestdrivendevelopment', u'GNAT Test Driven Development Documentation', + [u'AdaCore (c)'], 1) +] + +# If true, show URL addresses after external links. +#man_show_urls = False + + +# -- Options for Texinfo output ------------------------------------------------ + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + ('index', 'GNATTestDrivenDevelopment', u'GNAT Test Driven Development Documentation', + u'AdaCore (c)', 'GNATTestDrivenDevelopment', 'One line description of project.', + 'Miscellaneous'), +] + +# Documents to append as an appendix to all manuals. +#texinfo_appendices = [] + +# If false, no module index is generated. +#texinfo_domain_indices = True + +# How to display URL addresses: 'footnote', 'no', or 'inline'. +#texinfo_show_urls = 'footnote' + + +# -- Options for Epub output --------------------------------------------------- + +# Bibliographic Dublin Core info. +epub_title = u'GNAT Test Driven Development' +epub_author = u'AdaCore (c)' +epub_publisher = u'AdaCore (c)' +epub_copyright = u'2014, AdaCore (c)' + +# The language of the text. It defaults to the language option +# or en if the language is not set. +#epub_language = '' + +# The scheme of the identifier. Typical schemes are ISBN or URL. +#epub_scheme = '' + +# The unique identifier of the text. This can be a ISBN number +# or the project homepage. +#epub_identifier = '' + +# A unique identification for the text. +#epub_uid = '' + +# A tuple containing the cover image and cover page html template filenames. +#epub_cover = () + +# HTML files that should be inserted before the pages created by sphinx. +# The format is a list of tuples containing the path and title. +#epub_pre_files = [] + +# HTML files shat should be inserted after the pages created by sphinx. +# The format is a list of tuples containing the path and title. +#epub_post_files = [] + +# A list of files that should not be packed into the epub file. +#epub_exclude_files = [] + +# The depth of the table of contents in toc.ncx. +#epub_tocdepth = 3 + +# Allow duplicate toc entries. +#epub_tocdup = True diff --git a/docs/index.rst b/docs/index.rst new file mode 100644 index 0000000..d2681d8 --- /dev/null +++ b/docs/index.rst @@ -0,0 +1,23 @@ +.. GNAT Test Driven Development documentation master file, created by + sphinx-quickstart on Mon Feb 3 10:18:55 2014. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +GNAT Test Driven Development +============================ + +.. toctree:: + :maxdepth: 2 + + bdd + output + + + +Indices and tables +================== + +* :ref:`genindex` +* :ref:`modindex` +* :ref:`search` + diff --git a/docs/output.rst b/docs/output.rst new file mode 100644 index 0000000..451bea9 --- /dev/null +++ b/docs/output.rst @@ -0,0 +1,17 @@ +********************** +Controlling the output +********************** + +GNATbdd provides a rich set of options for controlling the output. + +Colors +====== + +Color output is enabled by default when the terminal supports it. It is used to +highlight passing, failing and skipped tests. + +On Windows, you must install the package `ANSICON +`_ to get color output. + +(See also https://pypi.python.org/pypi/colorama) +Or perhaps ansi.sys diff --git a/gnatbdd.gpr b/gnatbdd.gpr new file mode 100644 index 0000000..ec30ecb --- /dev/null +++ b/gnatbdd.gpr @@ -0,0 +1,12 @@ +with "gnatcoll"; + +project GNATBDD is + for Main use ("gnattdd-main.adb", "driver.adb", "test_colors.adb"); + for Languages use ("Ada", "C"); + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + + package Builder is + for Executable ("gnattdd-main.adb") use "gnattdd"; + end Builder; +end GNATBDD; diff --git a/src/colors.c b/src/colors.c new file mode 100644 index 0000000..a967b4d --- /dev/null +++ b/src/colors.c @@ -0,0 +1,30 @@ + +#ifdef _WIN32 + +#include + +int gnatcoll_get_console_screen_buffer_info(int forStderr) { + const HANDLE handle = + GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE); + CONSOLE_SCREEN_BUFFER_INFO csbiInfo; + + if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) { + return csbiInfo.wAttributes; + } + return -1; +} + +void gnatcoll_set_console_text_attribute(int forStderr, int attrs) { + const HANDLE handle = + GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE); + SetConsoleTextAttribute (handle, (WORD)attrs); +} + +#else +int gnatcoll_get_console_screen_buffer_info(int forStderr) { + return 0; +} +void gnatcoll_set_console_text_attribute(int forStderr, int attrs) { +} + +#endif diff --git a/src/driver.adb b/src/driver.adb new file mode 100644 index 0000000..3f1b02d --- /dev/null +++ b/src/driver.adb @@ -0,0 +1,11 @@ + +-- An example test driver. +-- Such code would be automatically generated by gnattdd + +with GNATTDD.Features; use GNATTDD.Features; + +procedure Driver is +begin + GNATTDD.Features.Discover_Features_Files ("."); + +end Driver; diff --git a/src/gnatcoll-terminal.adb b/src/gnatcoll-terminal.adb new file mode 100644 index 0000000..623ad41 --- /dev/null +++ b/src/gnatcoll-terminal.adb @@ -0,0 +1,307 @@ +------------------------------------------------------------------------------ +-- G N A T C O L L -- +-- -- +-- Copyright (C) 2005-2014, AdaCore -- +-- -- +-- This library is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 3, or (at your option) any later -- +-- version. This library is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Text_IO; use Ada.Text_IO; +with GNAT.OS_Lib; use GNAT.OS_Lib; + +package body GNATCOLL.Terminal is + + On_Windows : constant Boolean := GNAT.OS_Lib.Directory_Separator = '\'; + + Color_To_Win32 : constant array (ANSI_Color) of Integer := + (Unchanged => -1, + Black => 0, + Red => 4, + Green => 2, + Yellow => 6, + Blue => 1, + Magenta => 5, + Cyan => 3, + Grey => 7, + Reset => -1); + + Style_To_Win32 : constant array (ANSI_Style) of Integer := + (Unchanged => -1, + Bright => 16#08#, + Dim => 16#00#, -- same as Normal + Normal => 16#00#, + Reset_All => -1); + + procedure Win_Set_Console + (Self : Terminal_Info'Class; + Attrs : Integer); + -- Windows-specific implementation to change the attributes of the console + + ---------- + -- Init -- + ---------- + + procedure Init + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Colors : Supports_Color := Auto) + is + function getConsoleScreenBufferInfo (Stderr : Integer) return Integer; + pragma Import (C, getConsoleScreenBufferInfo, + "gnatcoll_get_console_screen_buffer_info"); + + type Mod_32 is mod 2 ** 32; + Attrs : Mod_32; + begin + Self.Is_Stderr := False; -- ??? + + if On_Windows then + Attrs := Mod_32 + (getConsoleScreenBufferInfo(Boolean'Pos (Self.Is_Stderr))); + if Attrs = -1 then + Self.Colors := Unsupported; + else + case Attrs and 7 is + when 0 => Self.Default_Fore := Black; + when 1 => Self.Default_Fore := Blue; + when 2 => Self.Default_Fore := Green; + when 3 => Self.Default_Fore := Cyan; + when 4 => Self.Default_Fore := Red; + when 5 => Self.Default_Fore := Magenta; + when 6 => Self.Default_Fore := Yellow; + when others => Self.Default_Fore := Grey ; + end case; + + case (Attrs / 16) and 7 is + when 0 => Self.Default_Back := Black; + when 1 => Self.Default_Back := Blue; + when 2 => Self.Default_Back := Green; + when 3 => Self.Default_Back := Cyan; + when 4 => Self.Default_Back := Red; + when 5 => Self.Default_Back := Magenta; + when 6 => Self.Default_Back := Yellow; + when others => Self.Default_Back := Grey ; + end case; + + if (Attrs and 16#08#) /= 0 then + Self.Default_Style := Bright; + else + Self.Default_Style := Normal; + end if; + + Set_Has_Colors (Self, Term, Colors); + end if; + + else + Set_Has_Colors (Self, Term, Colors); + end if; + end Init; + + -------------------- + -- Set_Has_Colors -- + -------------------- + + procedure Set_Has_Colors + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Support : Supports_Color := Auto) + is + Env : String_Access; + begin + case Support is + when No => + Self.Colors := Unsupported; + + when Yes => + if On_Windows then + Env := Getenv ("ANSICON"); + if Env = null or else Env.all = "" then + Self.Colors := WIN32_Sequences; + else + Self.Colors := ANSI_Sequences; + end if; + Free (Env); + else + Self.Colors := ANSI_Sequences; + end if; + + when Auto => + if On_Windows then + -- ??? Should check that we have a tty, not a file + Env := Getenv ("ANSICON"); + if Env = null or else Env.all = "" then + Self.Colors := WIN32_Sequences; + else + Self.Colors := ANSI_Sequences; + end if; + Free (Env); + else + -- ??? Should check whether we have a 'tty' + -- ??? if TermInfo.default_object.tigetnum("colors") == 0: + -- unsupported + -- ??? could look at the TERM environment variable + Self.Colors := ANSI_Sequences; + end if; + end case; + end Set_Has_Colors; + + ---------------- + -- Has_Colors -- + ---------------- + + function Has_Colors (Self : Terminal_Info) return Boolean is + begin + return Self.Colors /= Unsupported; + end Has_Colors; + + --------------------- + -- Win_Set_Console -- + --------------------- + + procedure Win_Set_Console + (Self : Terminal_Info'Class; + Attrs : Integer) + is + procedure Set_Console_Text_Attribute (Stderr : Integer; Attrs : Integer); + pragma Import (C, Set_Console_Text_Attribute, + "gnatcoll_set_console_text_attribute"); + begin + Set_Console_Text_Attribute (Boolean'Pos (Self.Is_Stderr), Attrs); + end Win_Set_Console; + + ------------ + -- Set_Fg -- + ------------ + + procedure Set_Fg + (Self : in out Terminal_Info; + Color : ANSI_Color; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output) + is + begin + Set_Color (Self, Term, Color, Unchanged, Unchanged); + end Set_Fg; + + ------------ + -- Set_Bg -- + ------------ + + procedure Set_Bg + (Self : in out Terminal_Info; + Color : ANSI_Color; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output) + is + begin + Set_Color (Self, Term, Unchanged, Color, Unchanged); + end Set_Bg; + + --------------- + -- Set_Style -- + --------------- + + procedure Set_Style + (Self : in out Terminal_Info; + Style : ANSI_Style; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output) + is + begin + Set_Color (Self, Term, Unchanged, Unchanged, Style); + end Set_Style; + + --------------- + -- Set_Color -- + --------------- + + procedure Set_Color + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Foreground : ANSI_Color := Unchanged; + Background : ANSI_Color := Unchanged; + Style : ANSI_Style := Unchanged) + is + Attrs : Integer := 0; + begin + case Self.Colors is + when Unsupported => + null; + + when ANSI_Sequences => + case Style is + when Unchanged => null; + when Bright => Put (Term, ASCII.ESC & "[1m"); + when Dim => Put (Term, ASCII.ESC & "[2m"); + when Normal => Put (Term, ASCII.ESC & "[22m"); + when Reset_All => Put (Term, ASCII.ESC & "[0m"); + end case; + + case Foreground is + when Unchanged => null; + when Black => Put (Term, ASCII.ESC & "[30m"); + when Red => Put (Term, ASCII.ESC & "[31m"); + when Green => Put (Term, ASCII.ESC & "[32m"); + when Yellow => Put (Term, ASCII.ESC & "[33m"); + when Blue => Put (Term, ASCII.ESC & "[34m"); + when Magenta => Put (Term, ASCII.ESC & "[35m"); + when Cyan => Put (Term, ASCII.ESC & "[36m"); + when Grey => Put (Term, ASCII.ESC & "[37m"); + when Reset => Put (Term, ASCII.ESC & "[39m"); + end case; + + case Background is + when Unchanged => null; + when Black => Put (Term, ASCII.ESC & "[40m"); + when Red => Put (Term, ASCII.ESC & "[41m"); + when Green => Put (Term, ASCII.ESC & "[42m"); + when Yellow => Put (Term, ASCII.ESC & "[43m"); + when Blue => Put (Term, ASCII.ESC & "[44m"); + when Magenta => Put (Term, ASCII.ESC & "[45m"); + when Cyan => Put (Term, ASCII.ESC & "[46m"); + when Grey => Put (Term, ASCII.ESC & "[47m"); + when Reset => Put (Term, ASCII.ESC & "[49m"); + end case; + + when WIN32_Sequences => + if Style = Reset_All then + Self.Style := Self.Default_Style; + Self.Fore := Self.Default_Fore; + Self.Back := Self.Default_Back; + elsif Style /= Unchanged then + Self.Style := Style; + end if; + + if Foreground = Reset then + Self.Fore := Self.Default_Fore; + elsif Foreground /= Unchanged then + Self.Fore := Foreground; + end if; + + if Background = Reset then + Self.Back := Self.Default_Back ; + elsif Background /= Unchanged then + Self.Back := Background; + end if; + + Attrs := Attrs + Style_To_Win32(Self.Style) + + Color_To_Win32(Self.Fore) + + Color_To_Win32(Self.Back) * 16; + + Win_Set_Console (Self, Attrs); + end case; + end Set_Color; + +end GNATCOLL.Terminal; diff --git a/src/gnatcoll-terminal.ads b/src/gnatcoll-terminal.ads new file mode 100644 index 0000000..2e3c64a --- /dev/null +++ b/src/gnatcoll-terminal.ads @@ -0,0 +1,133 @@ +------------------------------------------------------------------------------ +-- G N A T C O L L -- +-- -- +-- Copyright (C) 2014, AdaCore -- +-- -- +-- This library is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 3, or (at your option) any later -- +-- version. This library is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides a number of cross-platform subprograms to control +-- output in terminals, in particular colors. +-- +-- On Windows, color sequences are either set using the standard WIN32 codes, +-- or if the package ANSICON (https://github.com/adoxa/ansicon/) is running it +-- will use the standard ANSI sequences. + +with Ada.Text_IO; + +package GNATCOLL.Terminal is + + type Terminal_Info is tagged private; + -- Information about a terminal on which we output. + -- This structure does not encapsulate the terminal itself, which is a + -- limited type. + -- By default, this is configured without support for colors. It is thus + -- recommended to first call Init before you use this type. + -- This type is almost always used in conjonction with a File_Type, which + -- is where text is actually output. The properties of that File_Type are + -- queried and cached in the Terminal_Info. + + type Supports_Color is (Yes, No, Auto); + procedure Set_Has_Colors + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Support : Supports_Color := Auto); + function Has_Colors (Self : Terminal_Info) return Boolean; + -- Whether the terminals supports colors. You can use Set_Has_Colors + -- to force the unconditional use of colors, or to disable it. The default + -- is always to automatically detect whether they are supported. + + procedure Init + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Colors : Supports_Color := Auto); + -- Init Self. If Colors is Auto, checks whether Self supports color + -- output. + + type ANSI_Color is + (Unchanged, + Black, + Red, + Green, + Yellow, + Blue, + Magenta, + Cyan, + Grey, + Reset); + -- The colors that can be output in a terminal (ANSI definitions). The + -- actual color that the user will see might be different, since a terminal + -- might associate a different color to the same escape sequence. + + type ANSI_Style is + (Unchanged, + Bright, + Dim, + Normal, + Reset_All); + -- The style for the text. Some styles are not supported on some + -- terminals, like Dim on the Windows console. + + procedure Set_Color + (Self : in out Terminal_Info; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output; + Foreground : ANSI_Color := Unchanged; + Background : ANSI_Color := Unchanged; + Style : ANSI_Style := Unchanged); + -- Change the colors that will be used for subsequent output on the + -- terminal. + -- This procedure has no effect if Has_Colors returns False. + -- In general, it is not recommended to output colors to files, so you + -- should not use Set_Color in such a context. + + procedure Set_Fg + (Self : in out Terminal_Info; + Color : ANSI_Color; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output); + procedure Set_Bg + (Self : in out Terminal_Info; + Color : ANSI_Color; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output); + procedure Set_Style + (Self : in out Terminal_Info; + Style : ANSI_Style; + Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output); + -- Override specific colors. + +private + type Color_Sequence_Type is (Unsupported, ANSI_Sequences, WIN32_Sequences); + + type Terminal_Info is tagged record + Colors : Color_Sequence_Type := Unsupported; + + Fore : ANSI_Color := Black; + Back : ANSI_Color := Grey; + Style : ANSI_Style := Normal; + -- Current attributes (on Windows, all three must be changed at the + -- same time) + + Default_Fore : ANSI_Color := Black; + Default_Back : ANSI_Color := Grey; + Default_Style : ANSI_Style := Normal; + -- Default windows attributes (computed in Init) + + Is_Stderr : Boolean := False; + -- Whether the associated terminal is stdout (windows only) + end record; + +end GNATCOLL.Terminal; diff --git a/src/gnattdd-features.adb b/src/gnattdd-features.adb new file mode 100644 index 0000000..e69de29 diff --git a/src/gnattdd-features.ads b/src/gnattdd-features.ads new file mode 100644 index 0000000..156e873 --- /dev/null +++ b/src/gnattdd-features.ads @@ -0,0 +1,15 @@ + +package GNATTDD.Features is + + type Feature_Runner is tagged private; + + procedure Discover_Features + (Self : in out Feature_Runner; + Callback + +private + type Feature_Runner is tagged record + null; + end record; + +end GNATTDD.Features; diff --git a/src/gnattdd-main.adb b/src/gnattdd-main.adb new file mode 100644 index 0000000..d10584d --- /dev/null +++ b/src/gnattdd-main.adb @@ -0,0 +1,9 @@ +procedure GNATTDD.Main is + +begin + -- This subprogram generates the test driver by including all the + -- step definitions provided by the user, as well as the predefined + -- steps, regular epressions and mockups. + + null; +end GNATTDD.Main; diff --git a/src/gnattdd.ads b/src/gnattdd.ads new file mode 100644 index 0000000..d12dd2a --- /dev/null +++ b/src/gnattdd.ads @@ -0,0 +1,2 @@ +package GNATTDD is +end GNATTDD; diff --git a/src/test_colors.adb b/src/test_colors.adb new file mode 100644 index 0000000..1424403 --- /dev/null +++ b/src/test_colors.adb @@ -0,0 +1,56 @@ +with GNATCOLL.Terminal; use GNATCOLL.Terminal; +with Ada.Text_IO; use Ada.Text_IO; + +procedure Test_Colors is + Info : Terminal_Info; + + procedure Header (Name : String; Fg : ANSI_Color); + procedure Header (Name : String; Fg : ANSI_Color) is + begin + Info.Set_Color (Standard_Output, Fg, Reset, Normal); + Put (Name); + end Header; + + procedure Show (Name : String; Bg : ANSI_Color); + procedure Show (Name : String; Bg : ANSI_Color) is + begin + Info.Set_Color (Standard_Output, Reset, Bg, Normal); + Put (Name); + + for Fg in Black .. Grey loop + Info.Set_Color (Standard_Output, Fg, Bg, Normal); + Put ("X "); + Info.Set_Color (Standard_Output, Style => Dim); + Put ("X "); + Info.Set_Color (Standard_Output, Style => Bright); + Put ("X "); + Info.Set_Color (Standard_Output, Style => Reset_All); + Put (" "); + end loop; + + New_Line; + end Show; + +begin + Info.Init (Ada.Text_IO.Standard_Output, Auto); + + Header (" ", Reset); + Header ("black ", Black); + Header ("red ", Red); + Header ("green ", Green); + Header ("yellow ", Yellow); + Header ("blue ", Blue); + Header ("magenta", Magenta); + Header ("cyan ", Cyan); + Header ("white ", Grey); + New_Line; + + Show ("black ", Black); + Show ("red ", Red); + Show ("green ", Green); + Show ("yellow ", Yellow); + Show ("blue ", Blue); + Show ("magenta ", Magenta); + Show ("cyan ", Cyan); + Show ("white ", Grey); +end Test_Colors;