ada-libraries
/
gnatbdd
mirror of https://github.com/briot/gnatbdd
1
0
Fork 0
Code Issues Releases Wiki Activity

Initial revision

This commit is contained in:
Emmanuel Briot 2014-02-03 16:01:23 +01:00
commit eedc41435b
18 changed files with 1138 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
docs/_build
obj/
b__*
*.ali
*.d
*.a

153
docs/Makefile Normal file
View File

@ -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 <target>' where <target> 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."

0
docs/_static/.gitignore vendored Normal file
View File

0
docs/_templates/.gitignore vendored Normal file
View File

79
docs/bdd.rst Normal file
View File

@ -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.

285
docs/conf.py Normal file
View File

@ -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
# "<project> v<release> 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 <link> 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

23
docs/index.rst Normal file
View File

@ -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`

17
docs/output.rst Normal file
View File

@ -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
<https://github.com/adoxa/ansicon/>`_ to get color output.
(See also https://pypi.python.org/pypi/colorama)
Or perhaps ansi.sys

12
gnatbdd.gpr Normal file
View File

@ -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;

30
src/colors.c Normal file
View File

@ -0,0 +1,30 @@
#ifdef _WIN32
#include <windows.h>
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

11
src/driver.adb Normal file
View File

@ -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;

307
src/gnatcoll-terminal.adb Normal file
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
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;

133
src/gnatcoll-terminal.ads Normal file
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
-- 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;

0
src/gnattdd-features.adb Normal file
View File

15
src/gnattdd-features.ads Normal file
View File

@ -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;

9
src/gnattdd-main.adb Normal file
View File

@ -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;

2
src/gnattdd.ads Normal file
View File

@ -0,0 +1,2 @@
package GNATTDD is
end GNATTDD;

56
src/test_colors.adb Normal file
View File

@ -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;