├── .gitattributes ├── .gitignore ├── .gitlab-ci.yml ├── .gitreview ├── COPYING.RUNTIME ├── COPYING3 ├── README.md ├── cpp ├── cpp_string_support.cpp ├── gnatcoll-cpp-strings.adb ├── gnatcoll-cpp-strings.ads ├── gnatcoll-cpp.ads ├── gnatcoll_cpp.gpr └── setup.py ├── docs-common ├── Makefile ├── adacore-logo-white.png ├── common_conf.py ├── favicon.ico ├── important.png ├── note.png └── tip.png ├── gen_gps_help.py ├── gmp ├── README.md ├── examples │ ├── gmp_examples.gpr │ ├── isprime.adb │ └── square_triangular_numbers.adb ├── gmp_support.c ├── gnatcoll-gmp-integers-io.adb ├── gnatcoll-gmp-integers-io.ads ├── gnatcoll-gmp-integers-misc.adb ├── gnatcoll-gmp-integers-misc.ads ├── gnatcoll-gmp-integers-number_theoretic.adb ├── gnatcoll-gmp-integers-number_theoretic.ads ├── gnatcoll-gmp-integers-random.adb ├── gnatcoll-gmp-integers-random.ads ├── gnatcoll-gmp-integers-root_extraction.adb ├── gnatcoll-gmp-integers-root_extraction.ads ├── gnatcoll-gmp-integers.adb ├── gnatcoll-gmp-integers.ads ├── gnatcoll-gmp-lib.ads ├── gnatcoll-gmp-mpz_even_p.c ├── gnatcoll-gmp-mpz_odd_p.c ├── gnatcoll-gmp-mpz_sign.c ├── gnatcoll-gmp-random_state.adb ├── gnatcoll-gmp-random_state.ads ├── gnatcoll-gmp-rational_numbers.adb ├── gnatcoll-gmp-rational_numbers.ads ├── gnatcoll-gmp.ads ├── gnatcoll_gmp.gpr └── setup.py ├── gnat_debug.adc ├── gprproject ├── __init__.py ├── gprbuild.py ├── os.py └── testsuite │ ├── __init__.py │ ├── drivers │ ├── __init__.py │ ├── basic.py │ ├── gnatcov.py │ └── valgrind.py │ └── support │ ├── test.ads │ ├── test.gpr │ ├── test_assert.adb │ ├── test_assert.ads │ ├── test_measure.adb │ └── test_measure.ads ├── iconv ├── README.md ├── docs │ ├── Makefile │ ├── conf.py │ └── index.rst ├── gnatcoll-iconv.adb ├── gnatcoll-iconv.ads ├── gnatcoll_iconv.gpr ├── iconv_support.c └── setup.py ├── lzma ├── gnatcoll-coders-lzma-thin.ads ├── gnatcoll-coders-lzma.adb ├── gnatcoll-coders-lzma.ads ├── gnatcoll_lzma.gpr └── setup.py ├── omp ├── README.md ├── a-cvgpso.adb ├── a-cvgpso.ads ├── gnatcoll-omp-generic_array_sort.adb ├── gnatcoll-omp-generic_array_sort.ads ├── gnatcoll-omp-generic_constrained_array_sort.adb ├── gnatcoll-omp-generic_constrained_array_sort.ads ├── gnatcoll-omp.ads ├── gnatcoll_omp.gpr ├── setup.py └── sort_omp.c ├── python ├── README.md ├── docs │ ├── Makefile │ ├── conf.py │ └── index.rst ├── gnatcoll-any_types-python.adb ├── gnatcoll-any_types-python.ads ├── gnatcoll-python-state.adb ├── gnatcoll-python-state.ads ├── gnatcoll-python.adb ├── gnatcoll-python.ads ├── gnatcoll-scripts-python.adb ├── gnatcoll-scripts-python.ads ├── gnatcoll_python.gpr ├── python_support.c └── setup.py ├── python3 ├── README.md ├── gnatcoll-any_types-python.adb ├── gnatcoll-any_types-python.ads ├── gnatcoll-python-capsule.adb ├── gnatcoll-python-capsule.ads ├── gnatcoll-python-ctypes.ads ├── gnatcoll-python-errors.ads ├── gnatcoll-python-eval.ads ├── gnatcoll-python-exceptions.ads ├── gnatcoll-python-fileutils.adb ├── gnatcoll-python-fileutils.ads ├── gnatcoll-python-lifecycle.adb ├── gnatcoll-python-lifecycle.ads ├── gnatcoll-python-state.adb ├── gnatcoll-python-state.ads ├── gnatcoll-python.adb ├── gnatcoll-python.ads ├── gnatcoll-scripts-python.adb ├── gnatcoll-scripts-python.ads ├── gnatcoll_python.gpr ├── python_support.c ├── setup.py └── tests │ ├── support │ ├── test.gpr │ ├── test_assert.adb │ ├── test_assert.ads │ ├── test_common.adb │ ├── test_common.ads │ └── test_support.gpr │ ├── tests │ ├── class.getter_setter │ │ ├── my_test.py │ │ ├── test.adb │ │ └── test.yaml │ ├── class.gps_data │ │ ├── my_test.py │ │ ├── test.adb │ │ └── test.yaml │ ├── class.static │ │ ├── my_test.py │ │ ├── test.adb │ │ └── test.yaml │ ├── exception.from_ada │ │ ├── my_test.py │ │ ├── test.adb │ │ └── test.yaml │ ├── exception.from_python │ │ ├── my_test.py │ │ ├── test.adb │ │ └── test.yaml │ ├── lifecycle.py_main │ │ ├── test.adb │ │ └── test.yaml │ └── scripts.execute_file │ │ ├── simple_print.py │ │ ├── test.adb │ │ ├── test.py │ │ └── test.yaml │ └── testsuite.py ├── readline ├── README.md ├── docs │ ├── Makefile │ ├── conf.py │ └── index.rst ├── gnatcoll-readline.adb ├── gnatcoll-readline.ads ├── gnatcoll_readline.gpr └── setup.py ├── setup_support.py ├── syslog ├── README.md ├── docs │ ├── Makefile │ ├── conf.py │ └── index.rst ├── gnatcoll-traces-syslog.adb ├── gnatcoll-traces-syslog.ads ├── gnatcoll_syslog.gpr ├── setup.py └── syslog_support.c ├── testsuite ├── README.md ├── drivers │ ├── __init__.py │ ├── basic.py │ └── valgrind.py ├── e3-test.yaml ├── support │ ├── test.gpr │ ├── test_assert.adb │ ├── test_assert.ads │ ├── test_remote.adb │ └── test_remote.ads ├── tests │ ├── coders │ │ ├── save_streams.adb │ │ ├── save_streams.ads │ │ ├── test.adb │ │ ├── test.gpr │ │ ├── test.yaml │ │ ├── test_streams.adb │ │ └── test_streams.ads │ ├── cpp_strings │ │ ├── test.adb │ │ └── test.yaml │ ├── gmp │ │ ├── test.adb │ │ ├── test.yaml │ │ ├── test_bitwise.adb │ │ ├── test_div.adb │ │ ├── test_eq.adb │ │ ├── test_gcd.adb │ │ ├── test_image.adb │ │ ├── test_mod.adb │ │ ├── test_operators.adb │ │ ├── test_pow.adb │ │ ├── test_rationals.adb │ │ ├── test_rem.adb │ │ ├── test_roots.adb │ │ └── test_swap.adb │ ├── iconv │ │ ├── bad_charset │ │ │ ├── test.adb │ │ │ └── test.yaml │ │ └── iconv1 │ │ │ ├── test.adb │ │ │ └── test.yaml │ └── omp │ │ └── sort │ │ ├── test.adb │ │ ├── test.gpr │ │ └── test.yaml └── testsuite.py ├── version_information ├── zlib ├── gnatcoll-coders-zlib-thin.adb ├── gnatcoll-coders-zlib-thin.ads ├── gnatcoll-coders-zlib.adb ├── gnatcoll-coders-zlib.ads ├── gnatcoll_zlib.gpr └── setup.py └── zstd ├── README.md ├── config └── gnatcoll_zstd_constants.gpr ├── gnatcoll_zstd.gpr ├── gnatcoll_zstd.gpr.py ├── src ├── gnatcoll-coders-zstd.adb ├── gnatcoll-coders-zstd.ads ├── gnatcoll-zstd-controlled.adb ├── gnatcoll-zstd-controlled.ads ├── gnatcoll-zstd-streams.ads ├── gnatcoll-zstd.adb └── gnatcoll-zstd.ads └── testsuite ├── run-tests ├── support ├── save_streams.adb ├── save_streams.ads ├── test_streams.adb └── test_streams.ads └── tests ├── coders ├── reset │ ├── test.adb │ └── test.yaml ├── set_parameter │ ├── test.adb │ └── test.yaml └── transcode │ ├── test.adb │ └── test.yaml ├── file ├── test.adb └── test.yaml ├── threading ├── test.adb └── test.yaml ├── unbounded_string ├── test.adb └── test.yaml └── version ├── test.adb └── test.yaml /.gitattributes: -------------------------------------------------------------------------------- 1 | testsuite/*/*/* no-precommit-check 2 | testsuite/*/*/*/* no-precommit-check 3 | testsuite/*/*/*/*/* no-precommit-check 4 | python3/tests/*/*/* no-precommit-check 5 | python3/tests/*/* no-precommit-check 6 | python3/tests/* no-precommit-check 7 | 8 | # Third-party package 9 | src/getRSS.c no-precommit-check 10 | src/sqlite/amalgamation/* no-precommit-check 11 | 12 | src/dborm.py no-precommit-check 13 | src/xref.generated/* no-precommit-check 14 | distrib/gnatcoll/runtime.py no-precommit-check 15 | 16 | # ??? Workaround bug in style checker, which complains that 17 | # Finalization_Size is an unrecognized attribute 18 | src/gnatcoll-storage_pools-headers.adb no-precommit-check 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | makefile.setup 2 | 3 | gnat/ 4 | 5 | docs/_build 6 | 7 | *.cgpr 8 | b__* 9 | *.bexch 10 | *.a 11 | *.d 12 | gnatinspect.* 13 | obj/ 14 | lib/ 15 | install/ 16 | *.stdout 17 | *.stderr 18 | *.ali 19 | *.gli 20 | *.exe 21 | *.gcda 22 | *.gcno 23 | *.gcov 24 | *.bexch 25 | *.o 26 | *.deps 27 | *.pyc 28 | setup.json 29 | /gnat_src 30 | 31 | */docs/_build 32 | 33 | examples/library/obj 34 | 35 | out 36 | /testsuite/prod 37 | /testsuite/gcov 38 | /zstd/gnatcoll_zstd.json 39 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | workflow: 2 | rules: 3 | - if: $CI_PIPELINE_SOURCE == "merge_request_event" 4 | when: always 5 | - if: $CI_PIPELINE_SOURCE == "schedule" 6 | when: always 7 | - if: $CI_PIPELINE_SOURCE == "web" 8 | when: always 9 | - when: never 10 | 11 | stages: 12 | - build 13 | 14 | default: 15 | before_script: | 16 | echo "before script executing..." 17 | 18 | ####################### 19 | ## colored execution ## 20 | ####################### 21 | 22 | exec() { 23 | # dark green + $ + command line + grey 24 | echo -e "\e[0;32m\$ $@\e[0;37m" 25 | $@ 26 | # save the result 27 | res=$? 28 | # back to normal output 29 | echo -e -n "\e[0m" 30 | # make sure we translate the exit code 31 | return $res 32 | } 33 | 34 | # Enable generic CI for building with Anod 35 | 36 | cmd="generic_anod_ci" 37 | 38 | # generic anod ci requires --continuous-builder-mode when not run in a 39 | # MR context 40 | if [[ $CI_PIPELINE_SOURCE != "merge_request_event" ]]; then 41 | cmd="$cmd --continuous-builder-mode" 42 | fi 43 | 44 | exec eval $cmd 45 | echo "sourcing the generic CI environment" 46 | . /tmp/ci_env.sh 47 | 48 | exec anod vcs --list 49 | 50 | ######## 51 | # JOBS # 52 | ######## 53 | 54 | build_and_test: 55 | services: 56 | - image:e3 57 | - cpu:2 58 | stage: build 59 | interruptible: true 60 | parallel: 61 | matrix: 62 | - PYTHON: ["3.9", "3.10", "3.11", "3.12"] 63 | script: 64 | - anod test --latest gnatcoll-bindings -Qpython=$PYTHON 65 | - testsuite_reports 66 | artifacts: 67 | reports: 68 | junit: xunit-*.xml 69 | -------------------------------------------------------------------------------- /.gitreview: -------------------------------------------------------------------------------- 1 | [gerrit] 2 | host = git.adacore.com 3 | project = gnatcoll-bindings 4 | defaultbranch = master 5 | defaultremote = origin 6 | -------------------------------------------------------------------------------- /COPYING.RUNTIME: -------------------------------------------------------------------------------- 1 | GCC RUNTIME LIBRARY EXCEPTION 2 | 3 | Version 3.1, 31 March 2009 4 | 5 | Copyright (c) 2009 Free Software Foundation, Inc. 6 | 7 | Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. 8 | 9 | This GCC Runtime Library Exception ("Exception") is an additional permission under section 7 of the GNU General Public License, 10 | version 3 ("GPLv3"). It applies to a given file (the "Runtime Library") that bears a notice placed by the copyright holder of 11 | the file stating that the file is governed by GPLv3 along with this Exception. 12 | 13 | When you use GCC to compile a program, GCC may combine portions of certain GCC header files and runtime libraries with the 14 | compiled program. The purpose of this Exception is to allow compilation of non-GPL (including proprietary) programs to 15 | use, in this way, the header files and runtime libraries covered by this Exception. 16 | 17 | 0. Definitions. 18 | 19 | A file is an "Independent Module" if it either requires the Runtime Library for execution after a Compilation 20 | Process, or makes use of an interface provided by the Runtime Library, but is not otherwise based on the Runtime Library. 21 | 22 | "GCC" means a version of the GNU Compiler Collection, with or without modifications, governed by version 3 23 | (or a specified later version) of the GNU General Public License (GPL) with the option of using any subsequent 24 | versions published by the FSF. 25 | 26 | "GPL-compatible Software" is software whose conditions of propagation, modification and use would permit combination 27 | with GCC in accord with the license of GCC. 28 | 29 | "Target Code" refers to output from any compiler for a real or virtual target processor architecture, in executable 30 | form or suitable for input to an assembler, loader, linker and/or execution phase. Notwithstanding that, Target Code 31 | does not include data in any format that is used as a compiler intermediate representation, or used for producing a 32 | compiler intermediate representation. 33 | 34 | The "Compilation Process" transforms code entirely represented in non-intermediate languages designed for human-written 35 | code, and/or in Java Virtual Machine byte code, into Target Code. Thus, for example, use of source code generators and 36 | preprocessors need not be considered part of the Compilation Process, since the Compilation Process can be understood as 37 | starting with the output of the generators or preprocessors. 38 | 39 | A Compilation Process is "Eligible" if it is done using GCC, alone or with other GPL-compatible software, or if it is 40 | done without using any work based on GCC. For example, using non-GPL-compatible Software to optimize any GCC 41 | intermediate representations would not qualify as an Eligible Compilation Process. 42 | 43 | 1. Grant of Additional Permission. 44 | 45 | You have permission to propagate a work of Target Code formed by combining the Runtime Library with Independent Modules, 46 | even if such propagation would otherwise violate the terms of GPLv3, provided that all Target Code was generated by 47 | Eligible Compilation Processes. You may then convey such a combination under terms of your choice, consistent with the 48 | licensing of the Independent Modules. 49 | 50 | 2. No Weakening of GCC Copyleft. 51 | 52 | The availability of this Exception does not imply any general presumption that third-party software is unaffected by 53 | the copyleft requirements of the license of GCC. 54 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATcoll) - Bindings 2 | ==================================================== 3 | 4 | This is the bindings module of the GNAT Components Collection. Please refer to 5 | individual components for more details. 6 | 7 | Dependencies 8 | ------------ 9 | 10 | This module depends on the following external components, that should be 11 | available on your system: 12 | 13 | - GPRbuild 14 | - gnatcoll-core 15 | - As well as relevant third-party libraries you need to build bindings for. 16 | 17 | Building 18 | -------- 19 | 20 | The components of GNATcoll Bindings are built using standalone GPR project 21 | files. To build each of them you can simply do: 22 | 23 | ```sh 24 | $ gprbuild -P /gnatcoll-.gpr 25 | ``` 26 | 27 | However, this method has several limitations: 28 | 29 | * it builds one version of the library (static, relocatable and static-pic) 30 | at a time 31 | * it might depend on the environment (`C_INCLUDE_PATH`, `LIBRARY_PATH`, ...) 32 | 33 | In order to simplify that process, each component contains a Python script 34 | called `setup.py`. Each script provides the following subcommands: `build`, 35 | `install`, `clean`, `uninstall`. 36 | 37 | On the first call to `build`, the user can setup some preferences. You can do 38 | `setup.py build --help` to get the list of available options for each module. 39 | After first call previous preferences will be reused unless you use the 40 | `--reconfigure` switch. 41 | 42 | Note that you can perform an out-of-source-tree build by just invoking 43 | `setup.py` from another directory. 44 | 45 | 46 | Installing 47 | ---------- 48 | 49 | In order to install a given component, either call `gprinstall` or use 50 | `setup.py` script: 51 | 52 | ```sh 53 | $ setup.py install --prefix=some_path 54 | ``` 55 | 56 | Note that if `--prefix` is not used, then projects will be installed into the 57 | location of the used compiler. 58 | 59 | 60 | Bindings 61 | -------- 62 | 63 | The following bindings are provided: 64 | 65 | - [gmp](gmp/README.md) 66 | - [iconv](iconv/README.md) 67 | - lzma 68 | - [omp](omp/README.md) 69 | - [python](python/README.md) 70 | - [python3](python3/README.md) 71 | - [readline](readline/README.md) 72 | - [syslog](syslog/README.md) 73 | 74 | 75 | Bug reports 76 | ----------- 77 | 78 | Please send questions and bug reports to support@adacore.com following 79 | the same procedures used to submit reports with the GNAT toolset itself. 80 | -------------------------------------------------------------------------------- /cpp/gnatcoll-cpp.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2023, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- This package hierarchy provides binding to C++ Standard library functions 25 | 26 | package GNATCOLL.CPP is 27 | end GNATCOLL.CPP; 28 | -------------------------------------------------------------------------------- /cpp/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollCPP(SetupApp): 10 | name = 'gnatcoll_cpp' 11 | project = 'gnatcoll_cpp.gpr' 12 | description = 'GNATColl CPP bindings' 13 | 14 | def create(self): 15 | super(GNATCollCPP, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | def variants(self, config, cmd): 39 | result = [] 40 | for library_type in config.data['library_types']: 41 | gpr_vars = {'LIBRARY_TYPE': library_type, 42 | 'GPR_BUILD': library_type} 43 | if cmd == 'install': 44 | result.append((['--build-name=%s' % library_type, 45 | '--build-var=LIBRARY_TYPE'], 46 | gpr_vars)) 47 | else: 48 | result.append(([], gpr_vars)) 49 | return result 50 | 51 | 52 | if __name__ == '__main__': 53 | app = GNATCollCPP() 54 | sys.exit(app.run()) 55 | -------------------------------------------------------------------------------- /docs-common/adacore-logo-white.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/gnatcoll-bindings/4d3761dd658759b06aea4fdf028ba5a4bdf89785/docs-common/adacore-logo-white.png -------------------------------------------------------------------------------- /docs-common/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/gnatcoll-bindings/4d3761dd658759b06aea4fdf028ba5a4bdf89785/docs-common/favicon.ico -------------------------------------------------------------------------------- /docs-common/important.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/gnatcoll-bindings/4d3761dd658759b06aea4fdf028ba5a4bdf89785/docs-common/important.png -------------------------------------------------------------------------------- /docs-common/note.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/gnatcoll-bindings/4d3761dd658759b06aea4fdf028ba5a4bdf89785/docs-common/note.png -------------------------------------------------------------------------------- /docs-common/tip.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/gnatcoll-bindings/4d3761dd658759b06aea4fdf028ba5a4bdf89785/docs-common/tip.png -------------------------------------------------------------------------------- /gen_gps_help.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import os 4 | import os.path 5 | import re 6 | 7 | pkg_re = re.compile("^(private)?\s*package\s*(\S+)") 8 | 9 | 10 | def recursive_ls(dir): 11 | """Return the list of ads files in dir and its subdirs""" 12 | result = set() 13 | for f in os.listdir(dir): 14 | if f.endswith(".ads") \ 15 | and f.startswith("gnatcoll-"): 16 | 17 | private = False 18 | pkg = "" 19 | for l in file(os.path.join(dir, f)).readlines(): 20 | m = pkg_re.search(l) 21 | if m: 22 | private = m.group(1) 23 | pkg = m.group(2) 24 | break 25 | 26 | if not private: 27 | result.add((pkg, os.path.splitext(f)[0])) 28 | 29 | elif os.path.isdir(os.path.join(dir, f)): 30 | result = result.union(recursive_ls(os.path.join(dir, f))) 31 | 32 | return result 33 | 34 | list = recursive_ls("..") 35 | out = file("help_gnatcoll-bindings.py", "wb") 36 | out.write("""XML = r''' 37 | 38 | """) 39 | 40 | for pkg, f in sorted(list): 41 | if '__' in f: 42 | # An internal package with a specific naming scheme 43 | continue 44 | 45 | menu = pkg.replace(".", "/").replace("_", "__") 46 | 47 | # Do we have a submenu ? 48 | in_front = False 49 | for pkg2, b in list: 50 | if b.startswith(f + "-"): 51 | item = menu[menu.rfind("/") + 1:] 52 | menu = menu + "/<" + item + ">" 53 | break 54 | 55 | out.write(""" 56 | Editor.edit "%(file)s.ads" 57 | %(package)s 58 | /Help/%(menu)s 59 | GNAT Components Collection 60 | 61 | 62 | """ % {"file": f, "menu": menu, "package": pkg}) 63 | 64 | out.write("""''' 65 | import GPS 66 | GPS.parse_xml(XML) 67 | """) 68 | out.close() 69 | -------------------------------------------------------------------------------- /gmp/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - GMP 2 | =============================================== 3 | 4 | This is the GMP component of the GNAT Components Collection. 5 | 6 | It is an interface to the GNU Multiple Precision (GMP) arithmetic library. 7 | 8 | Dependencies 9 | ------------ 10 | 11 | This component requires the following external components, that should be 12 | available on your system: 13 | 14 | - gprbuild 15 | - gnatcoll-core 16 | - gmp 17 | -------------------------------------------------------------------------------- /gmp/examples/gmp_examples.gpr: -------------------------------------------------------------------------------- 1 | with "gnatcoll_gmp"; 2 | 3 | project GMP_Examples is 4 | for Main use ("square_triangular_numbers.adb", "isprime.adb"); 5 | for Object_Dir use "obj"; 6 | for Exec_Dir use "."; 7 | end GMP_Examples; 8 | 9 | -------------------------------------------------------------------------------- /gmp/examples/square_triangular_numbers.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- This program prints the first 50 "square triangular numbers", i.e., those 25 | -- that are both perfect squares and also are the sum of consecutive integers 26 | -- starting at one. The time required to calculate these numbers is also 27 | -- displayed. 28 | 29 | with GNAT.IO; use GNAT.IO; 30 | with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers; 31 | with GNATCOLL.GMP.Integers.IO; use GNATCOLL.GMP.Integers.IO; 32 | with Ada.Calendar; use Ada.Calendar; 33 | 34 | procedure Square_Triangular_Numbers is 35 | 36 | Values : array (1 .. 50) of Big_Integer; 37 | 38 | Start : Time; 39 | Elapsed : Duration; 40 | 41 | begin 42 | Start := Clock; 43 | 44 | Set (Values (1), To => 1); -- the first square triangular number 45 | Set (Values (2), To => 36); -- the second square triangular number 46 | 47 | for N in 3 .. Values'Last loop 48 | Set (Values (N), To => (34 * Values (N - 1)) - Values (N - 2) + 2); 49 | end loop; 50 | 51 | Elapsed := Clock - Start; 52 | 53 | for K in Values'Range loop 54 | Put (Values (K)); 55 | New_Line; 56 | end loop; 57 | 58 | Put_Line ("Computed" & Values'Last'Img & 59 | " values in" & Elapsed'Img & 60 | " seconds"); 61 | end Square_Triangular_Numbers; 62 | -------------------------------------------------------------------------------- /gmp/gmp_support.c: -------------------------------------------------------------------------------- 1 | /*------------------------------------------------------------------- 2 | G N A T C O L L -- 3 | -- 4 | Copyright (C) 2009-2017, AdaCore -- 5 | -- 6 | GPS is free software; you can redistribute it and/or modify it -- 7 | under the terms of the GNU General Public License as published by -- 8 | the Free Software Foundation; either version 2 of the License, or -- 9 | (at your option) any later version. -- 10 | -- 11 | This program is distributed in the hope that it will be useful, -- 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of -- 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 14 | General Public License for more details. You should have received -- 15 | a copy of the GNU General Public License along with this library; -- 16 | if not, write to the Free Software Foundation, Inc., 59 Temple -- 17 | Place - Suite 330, Boston, MA 02111-1307, USA. -- 18 | ---------------------------------------------------------------------*/ 19 | 20 | #include 21 | 22 | void gnatcoll_gmp_test() { 23 | mpz_t integ; 24 | mpz_init (integ); 25 | } 26 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-io.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Lib; use GNATCOLL.GMP.Lib; 25 | 26 | package body GNATCOLL.GMP.Integers.IO is 27 | 28 | --------- 29 | -- Put -- 30 | --------- 31 | 32 | procedure Put 33 | (This : Big_Integer; 34 | Base : Integer := 10; 35 | Stream : Interfaces.C_Streams.FILEs := Interfaces.C_Streams.stdout) 36 | is 37 | use Interfaces.C; 38 | Written : size_t; 39 | begin 40 | Written := mpz_out_str (Stream, 41 | Int (Base), 42 | This.Value'Access); 43 | if Written = 0 then 44 | raise Failure; 45 | end if; 46 | end Put; 47 | 48 | end GNATCOLL.GMP.Integers.IO; 49 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-io.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Interfaces.C_Streams; 25 | 26 | package GNATCOLL.GMP.Integers.IO is 27 | 28 | pragma Preelaborate; 29 | 30 | procedure Put 31 | (This : Big_Integer; 32 | Base : Integer := 10; 33 | Stream : Interfaces.C_Streams.FILEs := Interfaces.C_Streams.stdout); 34 | -- Output This on Stream, as a string of digits in base Base. The base 35 | -- argument may vary from 2 to 62 or from -2 to -36. 36 | -- 37 | -- For Base in the range 2..36, digits and lower-case letters are used; for 38 | -- -2..-36, digits and upper-case letters are used; for 37..62, digits, 39 | -- upper-case letters, and lower-case letters (in that significance order) 40 | -- are used. 41 | -- 42 | -- Raises Failure if the entire sequence of digits is not written. 43 | 44 | end GNATCOLL.GMP.Integers.IO; 45 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-misc.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Lib; use GNATCOLL.GMP.Lib; 25 | 26 | package body GNATCOLL.GMP.Integers.Misc is 27 | 28 | -------------------- 29 | -- As_Signed_Long -- 30 | -------------------- 31 | 32 | function As_Signed_Long (This : Big_Integer) return Long is 33 | begin 34 | return mpz_get_si (This.Value'Access); 35 | end As_Signed_Long; 36 | 37 | ---------------------- 38 | -- Fits_Signed_Long -- 39 | ---------------------- 40 | 41 | function Fits_Signed_Long (This : Big_Integer) return Boolean is 42 | begin 43 | return mpz_fits_slong_p (This.Value'Access) /= 0; 44 | end Fits_Signed_Long; 45 | 46 | --------- 47 | -- Odd -- 48 | --------- 49 | 50 | function Odd (This : Big_Integer) return Boolean is 51 | begin 52 | return mpz_odd_p (This.Value'Access) /= 0; 53 | end Odd; 54 | 55 | ---------- 56 | -- Even -- 57 | ---------- 58 | 59 | function Even (This : Big_Integer) return Boolean is 60 | begin 61 | return mpz_even_p (This.Value'Access) /= 0; 62 | end Even; 63 | 64 | ---------- 65 | -- Swap -- 66 | ---------- 67 | 68 | procedure Swap (This, That : in out Big_Integer) is 69 | begin 70 | mpz_swap (This.Value'Access, That.Value'Access); 71 | end Swap; 72 | 73 | end GNATCOLL.GMP.Integers.Misc; 74 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-misc.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package GNATCOLL.GMP.Integers.Misc is 25 | 26 | pragma Preelaborate; 27 | 28 | function As_Signed_Long (This : Big_Integer) return Long; 29 | -- If This fits into a signed long integer, returns the value of This. 30 | -- Otherwise returns the least significant part of This, with the same sign 31 | -- as This. 32 | 33 | pragma Inline (As_Signed_Long); 34 | 35 | function Fits_Signed_Long (This : Big_Integer) return Boolean; 36 | 37 | pragma Inline (Fits_Signed_Long); 38 | 39 | function Odd (This : Big_Integer) return Boolean; 40 | function Even (This : Big_Integer) return Boolean; 41 | 42 | pragma Inline (Odd); 43 | pragma Inline (Even); 44 | 45 | procedure Swap (This, That : in out Big_Integer); 46 | 47 | pragma Inline (Swap); 48 | 49 | end GNATCOLL.GMP.Integers.Misc; 50 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-number_theoretic.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Lib; use GNATCOLL.GMP.Lib; 25 | 26 | package body GNATCOLL.GMP.Integers.Number_Theoretic is 27 | 28 | ------------- 29 | -- Get_GCD -- 30 | ------------- 31 | 32 | procedure Get_GCD 33 | (Input1 : Big_Integer; 34 | Input2 : Big_Integer; 35 | Output : out Big_Integer) 36 | is 37 | begin 38 | mpz_gcd (Output.Value'Access, Input1.Value'Access, Input2.Value'Access); 39 | end Get_GCD; 40 | 41 | end GNATCOLL.GMP.Integers.Number_Theoretic; 42 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-number_theoretic.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package GNATCOLL.GMP.Integers.Number_Theoretic is 25 | 26 | pragma Preelaborate; 27 | 28 | procedure Get_GCD 29 | (Input1 : Big_Integer; 30 | Input2 : Big_Integer; 31 | Output : out Big_Integer); 32 | -- Set Output to the greatest common divisor of Input1 and Input2. The 33 | -- result is always positive even if one or both input operands are 34 | -- negative. 35 | 36 | pragma Inline (Get_GCD); 37 | 38 | end GNATCOLL.GMP.Integers.Number_Theoretic; 39 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-random.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Lib; use GNATCOLL.GMP.Lib; 25 | 26 | package body GNATCOLL.GMP.Integers.Random is 27 | 28 | ------------ 29 | -- Number -- 30 | ------------ 31 | 32 | function Number (State : Generator; N : Big_Integer) return Big_Integer is 33 | begin 34 | return Result : Big_Integer do 35 | mpz_urandomm (Result.Value'Access, 36 | As_gmp_randstate_t (State), 37 | N.Value'Access); 38 | end return; 39 | end Number; 40 | 41 | --------------------- 42 | -- Generate_Number -- 43 | --------------------- 44 | 45 | procedure Generate_Number 46 | (State : in out Generator; 47 | Into : out Big_Integer; 48 | N : Big_Integer) 49 | is 50 | begin 51 | mpz_urandomm (Into.Value'Access, 52 | As_gmp_randstate_t (State), 53 | N.Value'Access); 54 | end Generate_Number; 55 | 56 | ----------------- 57 | -- Number_Bits -- 58 | ----------------- 59 | 60 | function Number_Bits (State : Generator; N : Unsigned_Long) 61 | return Big_Integer 62 | is 63 | begin 64 | return Result : Big_Integer do 65 | mpz_urandomb (Result.Value'Access, As_gmp_randstate_t (State), N); 66 | end return; 67 | end Number_Bits; 68 | 69 | -------------------------- 70 | -- Generate_Number_Bits -- 71 | -------------------------- 72 | 73 | procedure Generate_Number_Bits 74 | (State : in out Generator; 75 | Into : out Big_Integer; 76 | N : Unsigned_Long) 77 | is 78 | begin 79 | mpz_urandomb (Into.Value'Access, 80 | As_gmp_randstate_t (State), 81 | N); 82 | end Generate_Number_Bits; 83 | 84 | end GNATCOLL.GMP.Integers.Random; 85 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-integers-random.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Random_State; use GNATCOLL.GMP.Random_State; 25 | 26 | package GNATCOLL.GMP.Integers.Random is 27 | 28 | pragma Preelaborate; 29 | 30 | function Number (State : Generator; N : Big_Integer) return Big_Integer; 31 | -- Generate a uniform random integer in the range 0 to N-1, inclusive 32 | 33 | procedure Generate_Number 34 | (State : in out Generator; 35 | Into : out Big_Integer; 36 | N : Big_Integer); 37 | -- Generate a uniform random integer in the range 0 to N-1, inclusive 38 | 39 | function Number_Bits (State : Generator; N : Unsigned_Long) 40 | return Big_Integer; 41 | -- Generate a uniformly distributed random integer in the range 0 to 42 | -- 2^N-1, inclusive 43 | 44 | procedure Generate_Number_Bits 45 | (State : in out Generator; 46 | Into : out Big_Integer; 47 | N : Unsigned_Long); 48 | -- Generate a uniformly distributed random integer in the range 0 to 49 | -- 2^N-1, inclusive 50 | 51 | end GNATCOLL.GMP.Integers.Random; 52 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-mpz_even_p.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------- 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- GPS is free software; you can redistribute it and/or modify it -- 7 | -- under the terms of the GNU General Public License as published by -- 8 | -- the Free Software Foundation; either version 2 of the License, or -- 9 | -- (at your option) any later version. -- 10 | -- -- 11 | -- This program is distributed in the hope that it will be useful, -- 12 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 14 | -- General Public License for more details. You should have received -- 15 | -- a copy of the GNU General Public License along with this library; -- 16 | -- if not, write to the Free Software Foundation, Inc., 59 Temple -- 17 | -- Place - Suite 330, Boston, MA 02111-1307, USA. -- 18 | ---------------------------------------------------------------------*/ 19 | 20 | #include 21 | 22 | /* a wrapper for mpz_even_p because it is only a macro and 23 | therefore cannot be imported */ 24 | 25 | int gmp_mpz_even_p (mpz_t OP) { 26 | return mpz_even_p (OP); 27 | } 28 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-mpz_odd_p.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------- 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- GPS is free software; you can redistribute it and/or modify it -- 7 | -- under the terms of the GNU General Public License as published by -- 8 | -- the Free Software Foundation; either version 2 of the License, or -- 9 | -- (at your option) any later version. -- 10 | -- -- 11 | -- This program is distributed in the hope that it will be useful, -- 12 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 14 | -- General Public License for more details. You should have received -- 15 | -- a copy of the GNU General Public License along with this library; -- 16 | -- if not, write to the Free Software Foundation, Inc., 59 Temple -- 17 | -- Place - Suite 330, Boston, MA 02111-1307, USA. -- 18 | ---------------------------------------------------------------------*/ 19 | 20 | #include 21 | 22 | /* a wrapper for mpz_odd_p because it is only a macro and 23 | therefore cannot be imported */ 24 | 25 | int gmp_mpz_odd_p (mpz_t OP) { 26 | return mpz_odd_p (OP); 27 | } 28 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp-mpz_sign.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------- 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- GPS is free software; you can redistribute it and/or modify it -- 7 | -- under the terms of the GNU General Public License as published by -- 8 | -- the Free Software Foundation; either version 2 of the License, or -- 9 | -- (at your option) any later version. -- 10 | -- -- 11 | -- This program is distributed in the hope that it will be useful, -- 12 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 14 | -- General Public License for more details. You should have received -- 15 | -- a copy of the GNU General Public License along with this library; -- 16 | -- if not, write to the Free Software Foundation, Inc., 59 Temple -- 17 | -- Place - Suite 330, Boston, MA 02111-1307, USA. -- 18 | ---------------------------------------------------------------------*/ 19 | 20 | #include 21 | 22 | /* a wrapper for mpz_sgn because mpz_sgn is only a macro and 23 | therefore cannot be imported */ 24 | 25 | int gmp_mpz_sgn (mpz_t OP) { 26 | return mpz_sgn(OP); 27 | } 28 | -------------------------------------------------------------------------------- /gmp/gnatcoll-gmp.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2022, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- An Ada interface to the GNU Multiple Precision (GMP) arithmetic library. 25 | -- See child packages for specific types, such as package GMP.Integers. 26 | 27 | with Interfaces.C; 28 | 29 | package GNATCOLL.GMP is 30 | 31 | pragma Pure; 32 | 33 | -- We define these numeric types here so that clients of the Ada binding 34 | -- do not also have to import package Interfaces.C themselves. 35 | -- These types correspond to those used by the underlying C implementation 36 | -- of the GMP library itself. 37 | 38 | type Int is new Interfaces.C.int; 39 | 40 | type Long is new Interfaces.C.long; 41 | 42 | type Unsigned_Long is new Interfaces.C.unsigned_long; 43 | 44 | type Double is new Interfaces.C.double; 45 | 46 | end GNATCOLL.GMP; 47 | -------------------------------------------------------------------------------- /gmp/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollGMP(SetupApp): 10 | name = 'gnatcoll_gmp' 11 | project = 'gnatcoll_gmp.gpr' 12 | description = 'GNATColl GMP bindings' 13 | 14 | def create(self): 15 | super(GNATCollGMP, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | # Set GNATCOLL_OS 39 | if 'darwin' in config.data['canonical_target']: 40 | gnatcoll_os = 'osx' 41 | elif 'windows' in config.data['canonical_target']: 42 | gnatcoll_os = 'windows' 43 | else: 44 | # Assume this is an Unix system 45 | gnatcoll_os = 'unix' 46 | config.set_data('GNATCOLL_OS', gnatcoll_os, sub='gprbuild') 47 | 48 | def variants(self, config, cmd): 49 | result = [] 50 | for library_type in config.data['library_types']: 51 | gpr_vars = {'LIBRARY_TYPE': library_type, 52 | 'XMLADA_BUILD': library_type, 53 | 'GPR_BUILD': library_type} 54 | if cmd == 'install': 55 | result.append((['--build-name=%s' % library_type, 56 | '--build-var=LIBRARY_TYPE'], 57 | gpr_vars)) 58 | else: 59 | result.append(([], gpr_vars)) 60 | return result 61 | 62 | 63 | if __name__ == '__main__': 64 | app = GNATCollGMP() 65 | sys.exit(app.run()) 66 | -------------------------------------------------------------------------------- /gnat_debug.adc: -------------------------------------------------------------------------------- 1 | pragma Initialize_Scalars; 2 | -------------------------------------------------------------------------------- /gprproject/os.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | from typing import TYPE_CHECKING 3 | import os 4 | import sys 5 | 6 | if TYPE_CHECKING: 7 | from typing import Any 8 | 9 | 10 | def add_search_path(name: str, path: str) -> None: 11 | """Prepend a path to a variable holding a list of paths. 12 | 13 | :param name: variable name 14 | :param path: path to add 15 | """ 16 | prev_value = os.environ.get(name) 17 | if prev_value: 18 | os.environ[name] = path + os.pathsep + prev_value 19 | else: 20 | os.environ[name] = path 21 | 22 | 23 | def which(prog: str, paths: str | None = None, default: Any = "") -> Any: 24 | """Locate executable. 25 | 26 | :param prog: program to find 27 | :param paths: if not None then we use this value instead of PATH to look 28 | for the executable. 29 | :param default: default value to return if not found 30 | 31 | :return: absolute path to the program on success, found by searching for an 32 | executable in the directories listed in the environment variable PATH 33 | or default value if not found 34 | """ 35 | 36 | def is_exe(file_path: str) -> bool: 37 | return os.path.isfile(file_path) and os.access(file_path, os.X_OK) 38 | 39 | def possible_names(file_path: str) -> list[str]: 40 | names = [file_path] 41 | if sys.platform == "win32": # unix: no cover 42 | names.extend( 43 | [ 44 | file_path + ext 45 | for ext in os.environ.get("PATHEXT", ".EXE").split(";") 46 | ] 47 | ) 48 | return names 49 | 50 | fpath, _ = os.path.split(prog) 51 | if fpath: 52 | # Full path given, check if executable 53 | for progname in possible_names(prog): 54 | if is_exe(progname): 55 | return progname 56 | else: 57 | # Check for all directories listed in $PATH 58 | if paths is None: 59 | paths = os.environ["PATH"] 60 | 61 | for pathdir in paths.split(os.pathsep): 62 | exe_file = os.path.join(pathdir, prog) 63 | for progname in possible_names(exe_file): 64 | if is_exe(progname): 65 | return progname 66 | 67 | # Not found. 68 | return default 69 | -------------------------------------------------------------------------------- /gprproject/testsuite/__init__.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | from e3.fs import rm, mkdir 3 | from e3.testsuite import Testsuite 4 | from .drivers.basic import BasicTestDriver 5 | from .drivers.gnatcov import produce_report 6 | import os 7 | import sys 8 | 9 | ROOT_DIR = os.path.dirname(os.path.abspath(__file__)) 10 | SUPPORT_DIR = os.path.join(ROOT_DIR, "support") 11 | 12 | 13 | class LibTestsuite(Testsuite): 14 | """Main class to derive in order to start a testsuite.""" 15 | 16 | enable_cross_support = True 17 | tests_subdir = "tests" 18 | test_driver_map = {"default": BasicTestDriver} 19 | 20 | @property 21 | def default_driver(self): 22 | return "default" 23 | 24 | @property 25 | def default_source_dirs(self) -> list[str]: 26 | result = [SUPPORT_DIR] 27 | if os.path.isdir(os.path.join(self.root_dir, "support")): 28 | result.append(os.path.join(self.root_dir, "support")) 29 | return result 30 | 31 | @property 32 | def default_project_file(self) -> str: 33 | return os.path.join(SUPPORT_DIR, "test.gpr") 34 | 35 | @property 36 | def default_withed_projects(self) -> list[str]: 37 | return [] 38 | 39 | def add_options(self, parser): 40 | group = parser.add_mutually_exclusive_group() 41 | group.add_argument( 42 | "--gnatcov", 43 | help="enable gnatcov mode. tested library should be built previously " 44 | "with --gnatcov too.", 45 | default=False, 46 | action="store_true" 47 | ) 48 | parser.add_argument( 49 | "--source-root", 50 | help="Option specific to the GNATcoverage Cobertura coverage" 51 | + " report: remove the specified prefix from the filenames in" 52 | + " the report. Must be used with the --gnatcov option.", 53 | default=None, 54 | ) 55 | group.add_argument( 56 | "--valgrind", 57 | help="check memory usage with Valgrind (memcheck tool)", 58 | action="store_true", 59 | ) 60 | 61 | def set_up(self) -> None: 62 | # Initialize if necessary gnatcov traces directory 63 | if self.main.args.gnatcov: 64 | self.env.gnatcov_dir = os.path.join( 65 | os.path.abspath(self.output_dir), "gnatcov-traces" 66 | ) 67 | self.env.source_root = self.main.args.source_root 68 | rm(self.env.gnatcov_dir, recursive=True) 69 | mkdir(self.env.gnatcov_dir) 70 | else: 71 | self.env.gnatcov_dir = None 72 | 73 | # Whether valgrind should be used or not 74 | self.env.valgrind = self.main.args.valgrind 75 | 76 | # Pass some global parameters 77 | self.env.default_project_file = self.default_project_file 78 | self.env.default_withed_projects = self.default_withed_projects 79 | self.env.default_source_dirs = self.default_source_dirs 80 | 81 | def tear_down(self) -> None: 82 | if self.env.gnatcov_dir: 83 | produce_report(self, self.output_dir, self.env.source_root) 84 | super().tear_down() 85 | 86 | @classmethod 87 | def main(cls, testsuite_root_dir: str) -> None: 88 | testsuite = cls(testsuite_root_dir) 89 | sys.exit(testsuite.testsuite_main()) 90 | -------------------------------------------------------------------------------- /gprproject/testsuite/drivers/valgrind.py: -------------------------------------------------------------------------------- 1 | from . import bin_check_call 2 | 3 | 4 | def check_call_valgrind(driver, cmd, slot, test_name=None, result=None, **kwargs): 5 | """ 6 | Wrapper for `e3.testsuite.process` that runs the process under Valgrind if 7 | this is a Valgrind-checked testsuite run. The process exit status will be 8 | 2 if Valgrind finds memory issues. 9 | """ 10 | if driver.env.valgrind: 11 | cmd = ["valgrind", "-q", "--error-exitcode=2", "--leak-check=full"] + cmd 12 | return bin_check_call(driver, cmd, slot, test_name, result, **kwargs) 13 | -------------------------------------------------------------------------------- /gprproject/testsuite/support/test.ads: -------------------------------------------------------------------------------- 1 | function Test return Integer; 2 | -------------------------------------------------------------------------------- /gprproject/testsuite/support/test.gpr: -------------------------------------------------------------------------------- 1 | -- Default project use for tests 2 | -- Note that the testsuite may add some with statemenets at the 3 | -- beginning of that file. 4 | 5 | project Test is 6 | Test_Sources := External_As_List ("TEST_SOURCES", ","); 7 | for Source_Dirs use (".") & Test_Sources; 8 | for Main use ("test.adb"); 9 | for Languages use ("Ada", "C"); 10 | for Object_Dir use "obj"; 11 | 12 | package Compiler is 13 | -- Building test programs in debug mode makes it easier to work with 14 | -- tests. 15 | for Switches ("Ada") use 16 | ("-g", "-O1", "-gnata", "-gnatyg", "-gnateE", 17 | "-gnatwaCJe", "-fstack-check", "-gnatw.P"); 18 | for Switches ("C") use ("-g", "-Wunreachable-code"); 19 | for Switches ("s-memory.adb") use ("-gnatg") & Compiler'Switches ("Ada"); 20 | end Compiler; 21 | end Test; 22 | -------------------------------------------------------------------------------- /gprproject/testsuite/support/test_measure.adb: -------------------------------------------------------------------------------- 1 | with Ada.Calendar; use Ada.Calendar; 2 | with Ada.Text_IO; 3 | 4 | package body Test_Measure is 5 | Start : Time; 6 | 7 | procedure Start_Measure is 8 | begin 9 | Start := Clock; 10 | end Start_Measure; 11 | 12 | procedure End_Measure (Message : String; Compare_With : Duration := 0.0) 13 | is 14 | Test_Time : constant Duration := Clock - Start; 15 | begin 16 | if Compare_With > 0.0 then 17 | declare 18 | Ratio : constant Long_Float := 19 | Long_Float (Test_Time) / Long_Float (Compare_With) * 100.0; 20 | begin 21 | Ada.Text_IO.Put_Line 22 | (Message & ":" & 23 | Integer (Ratio)'Img & "% compared to baseline"); 24 | end; 25 | end if; 26 | Ada.Text_IO.Put_Line (Message & ":" & Test_Time'Img & "s total time"); 27 | end End_Measure; 28 | end Test_Measure; 29 | -------------------------------------------------------------------------------- /gprproject/testsuite/support/test_measure.ads: -------------------------------------------------------------------------------- 1 | package Test_Measure is 2 | 3 | procedure Start_Measure; 4 | 5 | procedure End_Measure (Message : String; Compare_With : Duration := 0.0); 6 | 7 | end Test_Measure; 8 | -------------------------------------------------------------------------------- /iconv/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - Iconv 2 | ================================================= 3 | 4 | This is the Iconv component of the GNAT Components Collection. 5 | 6 | It is an interface to libiconv. 7 | There are multiple variants of libiconv: on some Unix systems it is part 8 | of the C library, whereas other systems have installed the GNU libiconv 9 | separately. Those variants work slightly differently. 10 | 11 | For historical reasons, international text is often encoded using a 12 | language or country dependent character encoding. With the advent of the 13 | internet and the frequent exchange of text across countries - even the 14 | viewing of a web page from a foreign country is a "text exchange" in this 15 | context -, conversions between these encodings have become important. They 16 | have also become a problem, because many characters which are present in 17 | one encoding are absent in many other encodings. To solve this mess, the 18 | Unicode encoding has been created. It is a super-encoding of all others and 19 | is therefore the default encoding for new text formats like XML. 20 | 21 | However, many computers still operate in locale with a traditional (limited) 22 | character encoding. Some programs, like mailers and web browsers, must be 23 | able to convert between a given text encoding and the user's encoding. 24 | Other programs internally store strings in Unicode, to facilitate internal 25 | processing, and need to convert between internal string representation 26 | (Unicode) and external string representation (a traditional encoding) when 27 | they are doing I/O. Libiconv is a conversion library for both kinds of 28 | applications. 29 | 30 | Dependencies 31 | ------------ 32 | 33 | This component requires the following external components, that should be 34 | available on your system: 35 | 36 | - gprbuild 37 | - gnatcoll-core 38 | - iconv 39 | -------------------------------------------------------------------------------- /iconv/docs/Makefile: -------------------------------------------------------------------------------- 1 | include ../../docs-common/Makefile 2 | -------------------------------------------------------------------------------- /iconv/docs/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | # 3 | # GNATcoll Bindings - Iconv documentation build configuration file 4 | 5 | # Load the base setup 6 | exec(open('../../docs-common/common_conf.py').read()) 7 | 8 | # General information about the project. 9 | project = u'GNATcoll Bindings - Iconv' 10 | 11 | # Output file base name for HTML help builder. 12 | htmlhelp_basename = 'GNATcoll-Iconv' 13 | 14 | # Grouping the document tree into LaTeX files. List of tuples 15 | # (source start file, target name, title, author, documentclass 16 | # [howto/manual]). 17 | latex_documents = [ 18 | ('index', 'GNATcoll-Iconv.tex', u'GNATcoll Bindings - Iconv Documentation', 19 | u'AdaCore', 'manual'), 20 | ] 21 | 22 | # One entry per manual page. List of tuples 23 | # (source start file, name, description, authors, manual section). 24 | man_pages = [ 25 | ('index', 'gnatcoll-iconv', u'GNATcoll Bindings - Iconv Documentation', 26 | [u'AdaCore'], 1) 27 | ] 28 | 29 | # Bibliographic Dublin Core info. 30 | epub_title = u'GNATcoll Bindings - Iconv' 31 | -------------------------------------------------------------------------------- /iconv/docs/index.rst: -------------------------------------------------------------------------------- 1 | GNATcoll Bindings - Iconv: Converting between character encodings 2 | ================================================================= 3 | 4 | .. index:: iconv 5 | .. index:: charset 6 | .. highlight:: ada 7 | 8 | This package provides a binding to the libiconv library. This library is 9 | standard on most Unix systems. When it is not provided by the system, the GNU 10 | libiconv package can be installed instead. 11 | 12 | Using GNATCOLL.Iconv 13 | ==================== 14 | 15 | Use the ``gnatcoll_iconv`` project in your project files. For instance:: 16 | 17 | with "gnatcoll_iconv"; 18 | project Default is 19 | ... 20 | end Default; 21 | 22 | API 23 | === 24 | 25 | The whole API is documented in :file:`gnatcoll-iconv.ads`. Here is a simple 26 | code sample that converts from iso-8859-1 encoding to UTF8:: 27 | 28 | with GNATCOLL.Iconv; use GNATCOLL.Iconv; 29 | procedure Main is 30 | EAcute : constant Character := Character'Val (16#E9#); 31 | -- in iso-8859-1 32 | 33 | Result : constant String := Iconv 34 | ("Some string " & EAcute, 35 | To_Code => UTF8, 36 | From_Code => ISO_8859_1); 37 | begin 38 | null; 39 | end Main; 40 | 41 | A more advanced (and somewhat more efficient) API is available via the 42 | ``Iconv`` procedure. In that procedure, you control the input and output 43 | buffers, so you will need less overall memory when you are converting big 44 | buffers. 45 | -------------------------------------------------------------------------------- /iconv/iconv_support.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Iconv binding support 3 | * Copyright (C) 2012-2017, AdaCore 4 | */ 5 | 6 | #include 7 | #include 8 | #include 9 | 10 | const int gnatcoll_errno_einval = EINVAL; 11 | const int gnatcoll_errno_e2big = E2BIG; 12 | const int gnatcoll_errno_eilseq = EILSEQ; 13 | 14 | void gnatcoll_iconv_set_locale(){ 15 | setlocale (LC_ALL, ""); 16 | } 17 | 18 | void *gnatcoll_iconv_open(char *tocode, char *fromcode){ 19 | iconv_t res = iconv_open(tocode, fromcode); 20 | return (res == (iconv_t) -1) ? NULL : res; 21 | } 22 | 23 | int gnatcoll_iconv_close(iconv_t cd) { 24 | // iconv_close might be a macro 25 | return iconv_close (cd); 26 | } 27 | 28 | #if _LIBICONV_VERSION >= 0x010D 29 | size_t gnatcoll_iconv 30 | (iconv_t cd, char** inbuf, size_t *inbytesleft, char** outbuf, 31 | size_t *outbytesleft) 32 | #else 33 | size_t gnatcoll_iconv 34 | (iconv_t cd, char** inbuf, size_t *inbytesleft, char** outbuf, 35 | size_t *outbytesleft) 36 | #endif 37 | { 38 | // iconv might be a macro 39 | return iconv(cd, inbuf, inbytesleft, outbuf, outbytesleft); 40 | } 41 | -------------------------------------------------------------------------------- /iconv/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollIconv(SetupApp): 10 | name = 'gnatcoll_iconv' 11 | project = 'gnatcoll_iconv.gpr' 12 | description = 'GNATColl Iconv bindings' 13 | 14 | def create(self): 15 | super(GNATCollIconv, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | self.build_cmd.add_argument( 22 | '--force-libiconv', 23 | help='if set force use of libiconv. By default on linux system ' 24 | 'we rely on libc rather than libiconv', 25 | action="store_true", 26 | default=False) 27 | 28 | def update_config(self, config, args): 29 | logging.info('%-26s %s', 30 | 'Libraries kind', ", ".join(config.data['library_types'])) 31 | 32 | # Set library version 33 | with open(os.path.join(config.source_dir, '..', 34 | 'version_information'), 'r') as fd: 35 | version = fd.read().strip() 36 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 37 | 38 | # Set build mode 39 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 40 | sub='gprbuild') 41 | logging.info('%-26s %s', 'Build mode', 42 | config.data['gprbuild']['BUILD']) 43 | 44 | # Set GNATCOLL_OS 45 | if 'darwin' in config.data['canonical_target']: 46 | gnatcoll_os = 'osx' 47 | elif 'windows' in config.data['canonical_target']: 48 | gnatcoll_os = 'windows' 49 | else: 50 | # Assume this is an Unix system 51 | gnatcoll_os = 'unix' 52 | config.set_data('GNATCOLL_OS', gnatcoll_os, sub='gprbuild') 53 | 54 | # Set GNATCOLL_ICONV_OPT 55 | if 'linux' in config.data['canonical_target'] and \ 56 | not args.force_libiconv: 57 | config.set_data('GNATCOLL_ICONV_OPT', '', sub='gprbuild') 58 | else: 59 | config.set_data('GNATCOLL_ICONV_OPT', '-liconv', sub='gprbuild') 60 | 61 | def variants(self, config, cmd): 62 | result = [] 63 | for library_type in config.data['library_types']: 64 | gpr_vars = {'LIBRARY_TYPE': library_type, 65 | 'XMLADA_BUILD': library_type, 66 | 'GPR_BUILD': library_type} 67 | if cmd == 'install': 68 | result.append((['--build-name=%s' % library_type, 69 | '--build-var=LIBRARY_TYPE'], 70 | gpr_vars)) 71 | else: 72 | result.append(([], gpr_vars)) 73 | return result 74 | 75 | 76 | if __name__ == '__main__': 77 | app = GNATCollIconv() 78 | sys.exit(app.run()) 79 | -------------------------------------------------------------------------------- /lzma/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollLZMA(SetupApp): 10 | name = 'gnatcoll_lzma' 11 | project = 'gnatcoll_lzma.gpr' 12 | description = 'GNATColl LZMA bindings' 13 | 14 | def create(self): 15 | super(GNATCollLZMA, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | def variants(self, config, cmd): 39 | result = [] 40 | for library_type in config.data['library_types']: 41 | gpr_vars = {'LIBRARY_TYPE': library_type, 42 | 'GPR_BUILD': library_type} 43 | if cmd == 'install': 44 | result.append((['--build-name=%s' % library_type, 45 | '--build-var=LIBRARY_TYPE'], 46 | gpr_vars)) 47 | else: 48 | result.append(([], gpr_vars)) 49 | return result 50 | 51 | 52 | if __name__ == '__main__': 53 | app = GNATCollLZMA() 54 | sys.exit(app.run()) 55 | -------------------------------------------------------------------------------- /omp/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - OMP 2 | =============================================== 3 | 4 | This is the OpenMP component of the GNAT Components Collection. 5 | 6 | It provides parallel implementations of Ada APIs (e.g. sorting) using 7 | the OpenMP library. 8 | 9 | Dependencies 10 | ------------ 11 | 12 | This component requires the following external components, that should be 13 | available on your system: 14 | 15 | - gprbuild 16 | - gnatcoll-core 17 | - libgomp (part of GCC) 18 | -------------------------------------------------------------------------------- /omp/gnatcoll-omp-generic_array_sort.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2019, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.OMP.Generic_Constrained_Array_Sort; 25 | 26 | procedure GNATCOLL.OMP.Generic_Array_Sort (Container : in out Array_Type) is 27 | subtype Index_Subtype is Index_Type range Container'First .. Container'Last; 28 | subtype Array_Subtype is Array_Type (Index_Subtype); 29 | procedure Sort is 30 | new GNATCOLL.OMP.Generic_Constrained_Array_Sort 31 | (Index_Type => Index_Subtype, 32 | Element_Type => Element_Type, 33 | Array_Type => Array_Subtype, 34 | "<" => "<"); 35 | 36 | begin 37 | Sort (Container); 38 | end GNATCOLL.OMP.Generic_Array_Sort; 39 | -------------------------------------------------------------------------------- /omp/gnatcoll-omp-generic_array_sort.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2019, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | generic 25 | type Index_Type is (<>); 26 | type Element_Type is private; 27 | type Array_Type is array (Index_Type range <>) of Element_Type; 28 | 29 | with function "<" (Left, Right : Element_Type) return Boolean is <>; 30 | 31 | procedure GNATCOLL.OMP.Generic_Array_Sort (Container : in out Array_Type); 32 | pragma Preelaborate (GNATCOLL.OMP.Generic_Array_Sort); 33 | -- This is the OpenMP version of Ada.Containers.Generic_Array_Sort 34 | -------------------------------------------------------------------------------- /omp/gnatcoll-omp-generic_constrained_array_sort.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2019, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | generic 25 | type Index_Type is (<>); 26 | type Element_Type is private; 27 | type Array_Type is array (Index_Type) of Element_Type; 28 | 29 | with function "<" (Left, Right : Element_Type) return Boolean is <>; 30 | 31 | procedure GNATCOLL.OMP.Generic_Constrained_Array_Sort 32 | (Container : in out Array_Type); 33 | pragma Preelaborate (GNATCOLL.OMP.Generic_Constrained_Array_Sort); 34 | -- This is the OpenMP version of Ada.Containers.Generic_Constrained_Array_Sort 35 | -------------------------------------------------------------------------------- /omp/gnatcoll-omp.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2019, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package GNATCOLL.OMP is 25 | pragma Preelaborate; 26 | 27 | procedure Set_Num_Threads (Num_Threads : Positive); 28 | pragma Import (C, Set_Num_Threads, "omp_set_num_threads"); 29 | -- Specifies the default number of threads used in OpenMP parallel 30 | -- sections. 31 | 32 | end GNATCOLL.OMP; 33 | -------------------------------------------------------------------------------- /omp/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollOMP(SetupApp): 10 | name = 'gnatcoll_omp' 11 | project = 'gnatcoll_omp.gpr' 12 | description = 'GNATColl OpenMP bindings' 13 | 14 | def create(self): 15 | super(GNATCollOMP, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | # Set GNATCOLL_OS 39 | if 'darwin' in config.data['canonical_target']: 40 | gnatcoll_os = 'osx' 41 | elif 'windows' in config.data['canonical_target']: 42 | gnatcoll_os = 'windows' 43 | else: 44 | # Assume this is an Unix system 45 | gnatcoll_os = 'unix' 46 | config.set_data('GNATCOLL_OS', gnatcoll_os, sub='gprbuild') 47 | 48 | def variants(self, config, cmd): 49 | result = [] 50 | for library_type in config.data['library_types']: 51 | gpr_vars = {'LIBRARY_TYPE': library_type, 52 | 'XMLADA_BUILD': library_type, 53 | 'GPR_BUILD': library_type} 54 | if cmd == 'install': 55 | result.append((['--build-name=%s' % library_type, 56 | '--build-var=LIBRARY_TYPE'], 57 | gpr_vars)) 58 | else: 59 | result.append(([], gpr_vars)) 60 | return result 61 | 62 | 63 | if __name__ == '__main__': 64 | app = GNATCollOMP() 65 | sys.exit(app.run()) 66 | -------------------------------------------------------------------------------- /python/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - Python 2 | ================================================== 3 | 4 | This is the Python component of the GNAT Components Collection. 5 | 6 | Standard interface to the Python 2 interpreter. NOTE: This binding is not 7 | compatible with Python 3. 8 | 9 | Dependencies 10 | ------------ 11 | 12 | This component requires the following external components, that should be 13 | available on your system: 14 | 15 | - gprbuild 16 | - gnatcoll-core 17 | - Python 2, at least version 2.3, but the most recent available version of 18 | Python 2 from ww.python.org is recommended. 19 | 20 | NOTE for Windows users: if you are installing the official distrib, you should 21 | install it in "just for me" mode, otherwise the python DLL will be placed in 22 | C:\Windows\System32 folder and it will result in shared library's link failure. 23 | The workaround in this case is to copy it by hand back to python install dir. 24 | -------------------------------------------------------------------------------- /python/docs/Makefile: -------------------------------------------------------------------------------- 1 | include ../../docs-common/Makefile 2 | -------------------------------------------------------------------------------- /python/docs/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | # 3 | # GNATcoll Bindings - Python documentation build configuration file 4 | 5 | # Load the base setup 6 | exec(open('../../docs-common/common_conf.py').read()) 7 | 8 | # General information about the project. 9 | project = u'GNATcoll Bindings - Python' 10 | 11 | # Output file base name for HTML help builder. 12 | htmlhelp_basename = 'GNATcoll-Python' 13 | 14 | # Grouping the document tree into LaTeX files. List of tuples 15 | # (source start file, target name, title, author, documentclass 16 | # [howto/manual]). 17 | latex_documents = [ 18 | ('index', 'GNATcoll-Python.tex', u'GNATcoll Bindings - Python Documentation', 19 | u'AdaCore', 'manual'), 20 | ] 21 | 22 | # One entry per manual page. List of tuples 23 | # (source start file, name, description, authors, manual section). 24 | man_pages = [ 25 | ('index', 'gnatcoll-python', u'GNATcoll Bindings - Python Documentation', 26 | [u'AdaCore'], 1) 27 | ] 28 | 29 | # Bibliographic Dublin Core info. 30 | epub_title = u'GNATcoll Bindings - Python' 31 | -------------------------------------------------------------------------------- /python/docs/index.rst: -------------------------------------------------------------------------------- 1 | GNATcoll Bindings - Python 2 | ========================== 3 | 4 | This component uses the ``GNATCOLL.Scripts`` API to provide interfacing with 5 | Python. Please refer to its documentation for an introduction to 6 | ``GNATCOLL.Scripts``. 7 | -------------------------------------------------------------------------------- /python/gnatcoll-any_types-python.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2017, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- This package provides a utilities to manipulate Python objects. This is not 25 | -- meant to be very performance-efficient, but to provide an interface simpler 26 | -- than the direct manipulation of PyObjects. 27 | 28 | with GNATCOLL.Python; use GNATCOLL.Python; 29 | 30 | package GNATCOLL.Any_Types.Python is 31 | 32 | function From_PyObject (Object : PyObject) return Any_Type; 33 | -- Create an Any_Type from the contents of Object. This creates copies in 34 | -- of any data in Object. 35 | -- Empty_Any_Type is returned if the underlying Python type (or its 36 | -- children in case of container types) is not supported. 37 | -- The result must be freed by the caller, by calling Free. 38 | 39 | end GNATCOLL.Any_Types.Python; 40 | -------------------------------------------------------------------------------- /python/gnatcoll-python-state.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2021, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package body GNATCOLL.Python.State is 25 | 26 | ---------------- 27 | -- Initialize -- 28 | ---------------- 29 | 30 | overriding procedure Initialize (Self : in out Ada_GIL_Lock) is 31 | begin 32 | Self.State := PyGILState_Ensure; 33 | end Initialize; 34 | 35 | -------------- 36 | -- Finalize -- 37 | -------------- 38 | 39 | overriding procedure Finalize (Self : in out Ada_GIL_Lock) is 40 | begin 41 | PyGILState_Release (Self.State); 42 | end Finalize; 43 | 44 | end GNATCOLL.Python.State; 45 | -------------------------------------------------------------------------------- /python/gnatcoll-python-state.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2021, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | -- Subprograms to manipulate GIL state and wrapper to simplify such 24 | -- operations in Ada code. 25 | 26 | with Ada.Finalization; 27 | 28 | package GNATCOLL.Python.State is 29 | 30 | type Ada_GIL_Lock is new Ada.Finalization.Limited_Controlled with private; 31 | -- This type is a wrapper around PyGILState_Ensure/Release, to avoid 32 | -- manual call to release, especially in the case of an exception. 33 | 34 | type PyGILState_STATE is private; 35 | 36 | PyGILState_LOCKED : constant PyGILState_STATE; 37 | PyGILState_UNLOCKED : constant PyGILState_STATE; 38 | 39 | function PyGILState_Ensure return PyGILState_STATE; 40 | pragma Import (C, PyGILState_Ensure, "ada_PyGILState_Ensure"); 41 | -- Ensure that the current thread is ready to call the Python C API 42 | -- regardless of the current state of Python, or of the global 43 | -- interpreter lock. This may be called as many times as desired by a 44 | -- thread as long as each call is matched with a call to 45 | -- PyGILState_Release(). 46 | 47 | procedure PyGILState_Release (State : PyGILState_STATE); 48 | pragma Import (C, PyGILState_Release, "ada_PyGILState_Release"); 49 | -- Release any resources previously acquired. After this call, Python's 50 | -- state will be the same as it was prior to the corresponding 51 | -- PyGILState_Ensure(). 52 | 53 | private 54 | overriding procedure Initialize (Self : in out Ada_GIL_Lock); 55 | overriding procedure Finalize (Self : in out Ada_GIL_Lock); 56 | 57 | type Ada_GIL_Lock is new Ada.Finalization.Limited_Controlled with record 58 | State : PyGILState_STATE; 59 | end record; 60 | 61 | type PyGILState_STATE is new Integer; 62 | 63 | PyGILState_LOCKED : constant PyGILState_STATE := 0; 64 | PyGILState_UNLOCKED : constant PyGILState_STATE := 1; 65 | 66 | end GNATCOLL.Python.State; 67 | -------------------------------------------------------------------------------- /python3/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - Python 2 | ================================================== 3 | 4 | This is the Python component of the GNAT Components Collection. 5 | 6 | Standard interface to the Python 3 interpreter. NOTE: This binding is not 7 | compatible with Python 2. 8 | 9 | Dependencies 10 | ------------ 11 | 12 | This component requires the following external components, that should be 13 | available on your system: 14 | 15 | - gprbuild 16 | - gnatcoll-core 17 | - Python 3, at least version 3.7, but the most recent available version of 18 | Python 3 from www.python.org is recommended. 19 | 20 | NOTE for Windows users: if you are installing the official distrib, you should 21 | install it in "just for me" mode, otherwise the python DLL will be placed in 22 | C:\Windows\System32 folder and it will result in shared library's link failure. 23 | The workaround in this case is to copy it by hand back to python install dir. 24 | -------------------------------------------------------------------------------- /python3/gnatcoll-any_types-python.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- This package provides a utilities to manipulate Python objects. This is not 25 | -- meant to be very performance-efficient, but to provide an interface simpler 26 | -- than the direct manipulation of PyObjects. 27 | 28 | with GNATCOLL.Python; use GNATCOLL.Python; 29 | 30 | package GNATCOLL.Any_Types.Python is 31 | 32 | function From_PyObject (Object : PyObject) return Any_Type; 33 | -- Create an Any_Type from the contents of Object. This creates copies in 34 | -- of any data in Object. 35 | -- Empty_Any_Type is returned if the underlying Python type (or its 36 | -- children in case of container types) is not supported. 37 | -- The result must be freed by the caller, by calling Free. 38 | 39 | end GNATCOLL.Any_Types.Python; 40 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-ctypes.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- Declaration of some low-level types used by python bindings. 25 | 26 | with Interfaces.C; 27 | with System; 28 | 29 | package GNATCOLL.Python.Ctypes is 30 | 31 | type Size_T is new Interfaces.C.size_t; 32 | type Char_Addr is new System.Address; 33 | type WChar_Addr is new System.Address; 34 | 35 | Null_WChar_Addr : WChar_Addr := WChar_Addr (System.Null_Address); 36 | 37 | end GNATCOLL.Python.Ctypes; 38 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-errors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2003-2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- Bindings to error handling functions 25 | 26 | package GNATCOLL.Python.Errors is 27 | 28 | function PyErr_Occurred return PyObject; 29 | pragma Import (C, PyErr_Occurred, "PyErr_Occurred"); 30 | -- Return value: Borrowed reference. 31 | -- 32 | -- Test whether the error indicator is set. If set, return the exception 33 | -- type (the first argument to the last call to one of the PyErr_Set*() 34 | -- functions or to PyErr_Restore()). If not set, return NULL. You do not 35 | -- own a reference to the return value, so you do not need to Py_DECREF() 36 | -- it. 37 | -- 38 | -- Note: Do not compare the return value to a specific exception. Use 39 | -- PyErr_ExceptionMatches() instead. The comparison could easily fail 40 | -- since the exception may be an instance instead of a class, 41 | -- in the case of a class exception, or it may be a subclass of the 42 | -- expected exception. 43 | 44 | end GNATCOLL.Python.Errors; 45 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-eval.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2003-2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package GNATCOLL.Python.Eval is 25 | 26 | function PyEval_SaveThread return PyThreadState; 27 | pragma Import (C, PyEval_SaveThread, "PyEval_SaveThread"); 28 | -- Release the global interpreter lock (if it has been created) and reset 29 | -- the thread state to NULL, returning the previous thread state (which 30 | -- is not NULL). If the lock has been created, the current thread must 31 | -- have acquired it. 32 | 33 | procedure PyEval_RestoreThread (State : PyThreadState); 34 | pragma Import (C, PyEval_RestoreThread, "PyEval_RestoreThread"); 35 | -- Acquire the global interpreter lock (if it has been created) and set 36 | -- the thread state to State, which must not be NULL. If the lock has 37 | -- been created, the current thread must not have acquired it, otherwise 38 | -- deadlock ensues. 39 | 40 | end GNATCOLL.Python.Eval; 41 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-exceptions.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- Exception that may be raised when using the present binding. 25 | 26 | package GNATCOLL.Python.Exceptions is 27 | 28 | DecodingError : exception; 29 | MemoryError : exception; 30 | 31 | end GNATCOLL.Python.Exceptions; 32 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-fileutils.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.Python.Exceptions; 25 | 26 | package body GNATCOLL.Python.Fileutils is 27 | use type C.WChar_Addr; 28 | use type C.Size_T; 29 | 30 | package Exc renames GNATCOLL.Python.Exceptions; 31 | 32 | --------------------- 33 | -- Py_DecodeLocale -- 34 | --------------------- 35 | 36 | function Py_DecodeLocale (Arg : String) return C.WChar_Addr 37 | is 38 | function Internal (Arg : String; Size : out C.Size_T) 39 | return C.WChar_Addr; 40 | pragma Import (C, Internal, "Py_DecodeLocale"); 41 | 42 | Result : C.WChar_Addr; 43 | Size : C.Size_T; 44 | begin 45 | Result := Internal (Arg => Arg & ASCII.NUL, 46 | Size => Size); 47 | if Result = C.Null_WChar_Addr then 48 | -- An error occured during decoding. 49 | if Size = C.Size_T'Last - 1 then 50 | raise Exc.MemoryError; 51 | else 52 | raise Exc.DecodingError; 53 | end if; 54 | end if; 55 | return Result; 56 | end Py_DecodeLocale; 57 | 58 | end GNATCOLL.Python.Fileutils; 59 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-fileutils.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2020, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- Bindings to functions declared in python include file fileutils.h 25 | 26 | with GNATCOLL.Python.Ctypes; 27 | 28 | package GNATCOLL.Python.Fileutils is 29 | 30 | package C renames GNATCOLL.Python.Ctypes; 31 | 32 | function Py_DecodeLocale (Arg : String) return C.WChar_Addr; 33 | -- Decode a byte string from the locale encoding with the surrogateescape 34 | -- error handler: undecodable bytes are decoded as characters in range 35 | -- U+DC80..U+DCFF. If a byte sequence can be decoded as a surrogate 36 | -- character, escape the bytes using the surrogateescape error handler 37 | -- instead of decoding them. 38 | 39 | -- Encoding, highest priority to lowest priority: 40 | -- * UTF-8 on macOS, Android, and VxWorks; 41 | -- * UTF-8 on Windows if Py_LegacyWindowsFSEncodingFlag is zero; 42 | -- * UTF-8 if the Python UTF-8 mode is enabled; 43 | -- * ASCII if the LC_CTYPE locale is "C", nl_langinfo(CODESET) returns 44 | -- the ASCII encoding (or an alias), and mbstowcs() and wcstombs() 45 | -- functions uses the ISO-8859-1 encoding. 46 | -- * the current locale encoding. 47 | 48 | -- Return a pointer to a newly allocated wide character string, use 49 | -- PyMem_RawFree() to free the memory. 50 | 51 | -- Raise DecodingError or MemoryError in case of error 52 | 53 | -- Decoding errors should never happen, unless there is a bug in the C 54 | -- library. 55 | 56 | end GNATCOLL.Python.Fileutils; 57 | -------------------------------------------------------------------------------- /python3/gnatcoll-python-state.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2003-2021, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | package body GNATCOLL.Python.State is 25 | 26 | ---------------- 27 | -- Initialize -- 28 | ---------------- 29 | 30 | overriding procedure Initialize (Self : in out Ada_GIL_Lock) is 31 | begin 32 | Self.State := PyGILState_Ensure; 33 | end Initialize; 34 | 35 | -------------- 36 | -- Finalize -- 37 | -------------- 38 | 39 | overriding procedure Finalize (Self : in out Ada_GIL_Lock) is 40 | begin 41 | PyGILState_Release (Self.State); 42 | end Finalize; 43 | 44 | end GNATCOLL.Python.State; 45 | -------------------------------------------------------------------------------- /python3/tests/support/test.gpr: -------------------------------------------------------------------------------- 1 | with "gnatcoll_python"; 2 | 3 | project Test is 4 | Test_Sources := External("TEST_SOURCES", ""); 5 | Support_Sources := External("SUPPORT_SOURCES", ""); 6 | for Source_Dirs use (Test_Sources, Support_Sources); 7 | for Main use ("test.adb"); 8 | for Languages use ("Ada"); 9 | for Object_Dir use "obj"; 10 | 11 | package Compiler is 12 | for Default_Switches ("Ada") use ("-g", "-gnata", "-gnatVa", "-gnatQ", "-gnato", "-gnatwe", "-Wall", 13 | "-fstack-check"); 14 | end Compiler; 15 | end Test; 16 | -------------------------------------------------------------------------------- /python3/tests/support/test_common.adb: -------------------------------------------------------------------------------- 1 | with Ada.Environment_Variables; 2 | with GNATCOLL.Python.Lifecycle; use GNATCOLL.Python.Lifecycle; 3 | 4 | package body Test_Common is 5 | 6 | package Env renames Ada.Environment_Variables; 7 | 8 | function Python_Home return String is 9 | begin 10 | return Env.Value ("ADA_PYTHON_HOME"); 11 | end Python_Home; 12 | 13 | procedure Set_Python_Home is 14 | begin 15 | Py_SetPythonHome (Python_Home); 16 | end Set_Python_Home; 17 | end Test_Common; 18 | -------------------------------------------------------------------------------- /python3/tests/support/test_common.ads: -------------------------------------------------------------------------------- 1 | package Test_Common is 2 | 3 | function Python_Home return String; 4 | 5 | procedure Set_Python_Home; 6 | 7 | end Test_Common; 8 | -------------------------------------------------------------------------------- /python3/tests/support/test_support.gpr: -------------------------------------------------------------------------------- 1 | project Test_Support is 2 | 3 | for Source_Dirs use ("."); 4 | for Object_Dir use "obj/support"; 5 | for Languages use ("Ada"); 6 | end Test_Support; 7 | -------------------------------------------------------------------------------- /python3/tests/tests/class.getter_setter/my_test.py: -------------------------------------------------------------------------------- 1 | from Test import My_Class 2 | 3 | # pass an integer in the field waiting for a float 4 | m = My_Class(42) 5 | # the returned value should be a float 6 | assert m.get_value() == 42.0 7 | assert My_Class.get_value(m) == 42.0 8 | # Computation 9 | m.set_value(m.get_value() / 2 + 0.1) 10 | # Verify the value almost match 11 | assert str(m.get_value()).startswith("21.1") 12 | print('<=== TEST PASSED ===>') 13 | -------------------------------------------------------------------------------- /python3/tests/tests/class.getter_setter/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Common; 4 | 5 | function Test return Integer 6 | is 7 | Repository : Scripts_Repository := null; 8 | Python : Python_Scripting := null; 9 | Errors : Boolean; 10 | 11 | procedure My_Class_Handler 12 | (Data : in out Callback_Data'Class; 13 | Command : String); 14 | 15 | ---------------------- 16 | -- My_Class_Handler -- 17 | ---------------------- 18 | 19 | procedure My_Class_Handler 20 | (Data : in out Callback_Data'Class; 21 | Command : String) is 22 | begin 23 | if Command = Constructor_Method then 24 | declare 25 | My_Inst : constant Class_Instance := Nth_Arg (Data, 1); 26 | Val : constant Float := Nth_Arg (Data, 2); 27 | begin 28 | Set_Data (My_Inst, "value", Create_Property (Val)); 29 | end; 30 | elsif Command = "get_value" then 31 | declare 32 | My_Inst : constant Class_Instance := Nth_Arg (Data, 1); 33 | begin 34 | Set_Return_Value (Data, Get_Data (My_Inst, "value").As_Float); 35 | end; 36 | elsif Command = "set_value" then 37 | declare 38 | My_Inst : constant Class_Instance := Nth_Arg (Data, 1); 39 | Val : constant Float := Nth_Arg (Data, 2); 40 | begin 41 | Set_Data (My_Inst, "value", Create_Property (Val)); 42 | end; 43 | end if; 44 | end My_Class_Handler; 45 | 46 | begin 47 | Test_Common.Set_Python_Home; 48 | 49 | Repository := new Scripts_Repository_Record; 50 | Register_Python_Scripting 51 | (Repo => Repository, 52 | Module => "Test"); 53 | Python := GNATCOLL.Scripts.Python.Python_Scripting 54 | (GNATCOLL.Scripts.Lookup_Scripting_Language 55 | (Repository, Python_Name)); 56 | 57 | declare 58 | My_Class : constant Class_Type := Repository.New_Class ("My_Class"); 59 | begin 60 | Repository.Register_Command 61 | (Command => Constructor_Method, 62 | Params => (1 .. 1 => Param ("value")), 63 | Handler => My_Class_Handler'Unrestricted_Access, 64 | Class => My_Class); 65 | 66 | Repository.Register_Command 67 | (Command => "get_value", 68 | Handler => My_Class_Handler'Unrestricted_Access, 69 | Class => My_Class); 70 | 71 | Repository.Register_Command 72 | (Command => "set_value", 73 | Params => (1 .. 1 => Param ("new_value")), 74 | Handler => My_Class_Handler'Unrestricted_Access, 75 | Class => My_Class); 76 | end; 77 | 78 | Python.Execute_File 79 | (Filename => "my_test.py", 80 | Show_Command => False, 81 | Errors => Errors); 82 | Python.Destroy; 83 | 84 | return 0; 85 | end Test; 86 | -------------------------------------------------------------------------------- /python3/tests/tests/class.getter_setter/test.yaml: -------------------------------------------------------------------------------- 1 | description: test the creation of getter/setter 2 | goals: | 3 | The test creates a class named My_Class which has a getter and a setter 4 | for its hidden property named "value" of type float. 5 | -------------------------------------------------------------------------------- /python3/tests/tests/class.gps_data/my_test.py: -------------------------------------------------------------------------------- 1 | from Test import My_Class 2 | 3 | m = My_Class("FooBar") 4 | assert m.Get_Property() == "FooBar" 5 | print('<=== TEST PASSED ===>') 6 | -------------------------------------------------------------------------------- /python3/tests/tests/class.gps_data/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Common; 4 | 5 | function Test return Integer 6 | is 7 | Repository : Scripts_Repository := null; 8 | Python : Python_Scripting := null; 9 | Errors : Boolean; 10 | 11 | procedure My_Class_Handler 12 | (Data : in out Callback_Data'Class; 13 | Command : String); 14 | 15 | ---------------------- 16 | -- My_Class_Handler -- 17 | ---------------------- 18 | 19 | procedure My_Class_Handler 20 | (Data : in out Callback_Data'Class; 21 | Command : String) 22 | is 23 | Property_Name : constant String := "My_Property"; 24 | begin 25 | if Command = Constructor_Method then 26 | declare 27 | My_Inst : constant Class_Instance := Nth_Arg (Data, 1); 28 | Name : constant String := Nth_Arg (Data, 2); 29 | begin 30 | Set_Data (My_Inst, Property_Name, Create_Property (Name)); 31 | end; 32 | elsif Command = "Get_Property" then 33 | declare 34 | My_Inst : constant Class_Instance := Nth_Arg (Data, 1); 35 | begin 36 | Set_Return_Value 37 | (Data, Get_Data (My_Inst, Property_Name).As_String); 38 | end; 39 | end if; 40 | end My_Class_Handler; 41 | 42 | begin 43 | Test_Common.Set_Python_Home; 44 | 45 | Repository := new Scripts_Repository_Record; 46 | Register_Python_Scripting 47 | (Repo => Repository, 48 | Module => "Test"); 49 | Python := GNATCOLL.Scripts.Python.Python_Scripting 50 | (GNATCOLL.Scripts.Lookup_Scripting_Language 51 | (Repository, Python_Name)); 52 | 53 | declare 54 | My_Class : constant Class_Type := Repository.New_Class ("My_Class"); 55 | begin 56 | Repository.Register_Command 57 | (Command => Constructor_Method, 58 | Params => (1 .. 1 => Param ("name")), 59 | Handler => My_Class_Handler'Unrestricted_Access, 60 | Class => My_Class); 61 | 62 | Repository.Register_Command 63 | (Command => "Get_Property", 64 | Handler => My_Class_Handler'Unrestricted_Access, 65 | Class => My_Class); 66 | end; 67 | 68 | Python.Execute_File 69 | (Filename => "my_test.py", 70 | Show_Command => False, 71 | Errors => Errors); 72 | Python.Destroy; 73 | 74 | return 0; 75 | end Test; 76 | -------------------------------------------------------------------------------- /python3/tests/tests/class.gps_data/test.yaml: -------------------------------------------------------------------------------- 1 | description: test the creation of the hidden property __gps_data 2 | goals: | 3 | The test generates a python class named My_Class and add the hidden 4 | property __gps_data. Then it will verify the data stored inside __gps_data 5 | can easily be retrieved in the Ada layer. 6 | -------------------------------------------------------------------------------- /python3/tests/tests/class.static/my_test.py: -------------------------------------------------------------------------------- 1 | from Test import My_Class 2 | 3 | assert My_Class.Hello() == "Hello World!" 4 | print('<=== TEST PASSED ===>') 5 | -------------------------------------------------------------------------------- /python3/tests/tests/class.static/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Common; 4 | 5 | function Test return Integer 6 | is 7 | Repository : Scripts_Repository := null; 8 | Python : Python_Scripting := null; 9 | Errors : Boolean; 10 | 11 | procedure My_Class_Handler 12 | (Data : in out Callback_Data'Class; 13 | Command : String); 14 | 15 | ---------------------- 16 | -- My_Class_Handler -- 17 | ---------------------- 18 | 19 | procedure My_Class_Handler 20 | (Data : in out Callback_Data'Class; 21 | Command : String) is 22 | begin 23 | if Command = "Hello" then 24 | declare 25 | Val : constant String := "Hello World!"; 26 | begin 27 | Set_Return_Value (Data, Val); 28 | end; 29 | end if; 30 | end My_Class_Handler; 31 | begin 32 | Test_Common.Set_Python_Home; 33 | 34 | Repository := new Scripts_Repository_Record; 35 | Register_Python_Scripting 36 | (Repo => Repository, 37 | Module => "Test"); 38 | Python := GNATCOLL.Scripts.Python.Python_Scripting 39 | (GNATCOLL.Scripts.Lookup_Scripting_Language 40 | (Repository, Python_Name)); 41 | 42 | declare 43 | My_Class : constant Class_Type := Repository.New_Class ("My_Class"); 44 | begin 45 | Repository.Register_Command 46 | (Command => "Hello", 47 | Handler => My_Class_Handler'Unrestricted_Access, 48 | Class => My_Class, 49 | Static_Method => True); 50 | end; 51 | 52 | Python.Execute_File 53 | (Filename => "my_test.py", 54 | Show_Command => False, 55 | Errors => Errors); 56 | Python.Destroy; 57 | 58 | return 0; 59 | end Test; 60 | -------------------------------------------------------------------------------- /python3/tests/tests/class.static/test.yaml: -------------------------------------------------------------------------------- 1 | description: test the creation of static method 2 | goals: | 3 | Creates a class named My_Class with a staticmethod named Hello. 4 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_ada/my_test.py: -------------------------------------------------------------------------------- 1 | from Test import My_Class 2 | 3 | try: 4 | My_Class.raise_error() 5 | assert False # Should be unreachable 6 | except Exception as e: 7 | assert str(e) == "My_Error_Message" 8 | print('<=== TEST PASSED ===>') 9 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_ada/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Common; 4 | 5 | function Test return Integer 6 | is 7 | Repository : Scripts_Repository := null; 8 | Python : Python_Scripting := null; 9 | Errors : Boolean; 10 | 11 | procedure My_Class_Handler 12 | (Data : in out Callback_Data'Class; 13 | Command : String); 14 | 15 | ---------------------- 16 | -- My_Class_Handler -- 17 | ---------------------- 18 | 19 | procedure My_Class_Handler 20 | (Data : in out Callback_Data'Class; 21 | Command : String) is 22 | begin 23 | if Command = "raise_error" then 24 | Set_Error_Msg (Data, "My_Error_Message"); 25 | end if; 26 | end My_Class_Handler; 27 | begin 28 | Test_Common.Set_Python_Home; 29 | 30 | Repository := new Scripts_Repository_Record; 31 | Register_Python_Scripting 32 | (Repo => Repository, 33 | Module => "Test"); 34 | Python := GNATCOLL.Scripts.Python.Python_Scripting 35 | (GNATCOLL.Scripts.Lookup_Scripting_Language 36 | (Repository, Python_Name)); 37 | 38 | declare 39 | My_Class : constant Class_Type := Repository.New_Class ("My_Class"); 40 | begin 41 | Repository.Register_Command 42 | (Command => "raise_error", 43 | Handler => My_Class_Handler'Unrestricted_Access, 44 | Class => My_Class, 45 | Static_Method => True); 46 | end; 47 | 48 | Python.Execute_File 49 | (Filename => "my_test.py", 50 | Show_Command => False, 51 | Errors => Errors); 52 | Python.Destroy; 53 | 54 | return 0; 55 | end Test; 56 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_ada/test.yaml: -------------------------------------------------------------------------------- 1 | description: test the propagation of error from Ada to Python 2 | goals: | 3 | Creates a class named My_Class with a static method "raise_error" which 4 | raises an error with a custom message. The error and the message should 5 | properly be propagated to the Python script. 6 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_python/my_test.py: -------------------------------------------------------------------------------- 1 | raise TypeError("Hello World") 2 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_python/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Assert; 4 | with Test_Common; 5 | 6 | function Test return Integer 7 | is 8 | Repository : Scripts_Repository := null; 9 | Python : Python_Scripting := null; 10 | Errors : Boolean; 11 | begin 12 | Test_Common.Set_Python_Home; 13 | 14 | Repository := new Scripts_Repository_Record; 15 | Register_Python_Scripting 16 | (Repo => Repository, 17 | Module => "Test"); 18 | Python := GNATCOLL.Scripts.Python.Python_Scripting 19 | (GNATCOLL.Scripts.Lookup_Scripting_Language 20 | (Repository, Python_Name)); 21 | Python.Execute_File 22 | (Filename => "my_test.py", 23 | Show_Command => False, 24 | Errors => Errors); 25 | 26 | Test_Assert.Assert 27 | (Success => Errors, 28 | Msg => "The python script should raise an error."); 29 | 30 | Python.Destroy; 31 | return Test_Assert.Report; 32 | end Test; 33 | -------------------------------------------------------------------------------- /python3/tests/tests/exception.from_python/test.yaml: -------------------------------------------------------------------------------- 1 | description: test propagation of exception from Python to Ada 2 | goals: | 3 | Execute a python script raising an exception check that the Ada layer 4 | recieved the error. 5 | -------------------------------------------------------------------------------- /python3/tests/tests/lifecycle.py_main/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Python.Lifecycle; use GNATCOLL.Python.Lifecycle; 2 | with GNATCOLL.Python; use GNATCOLL.Python; 3 | with Test_Assert; 4 | with Test_Common; 5 | 6 | function Test return Integer is 7 | 8 | package A renames Test_Assert; 9 | 10 | Status : Interpreter_Status; 11 | begin 12 | Py_SetPythonHome (Test_Common.Python_Home); 13 | Py_SetProgramName; 14 | Py_Initialize; 15 | Status := Py_Main; 16 | A.Assert(Status = Interpreter_Exit_Normally, "Interpreter failure"); 17 | Py_Finalize; 18 | return A.Report; 19 | end Test; 20 | -------------------------------------------------------------------------------- /python3/tests/tests/lifecycle.py_main/test.yaml: -------------------------------------------------------------------------------- 1 | description: test using python interpreter main loop 2 | goals: | 3 | The goal of the test is to use GNATCOLL.Python.Lifecycle.Py_Main 4 | to launch the interpreter console loop. The test also ensure that 5 | arguments on the command line are passed correctly to the Python 6 | interpreter. 7 | test_args: ["-c", "import sys; print(sys.executable)"] 8 | -------------------------------------------------------------------------------- /python3/tests/tests/scripts.execute_file/simple_print.py: -------------------------------------------------------------------------------- 1 | print('Hello from python binding') 2 | -------------------------------------------------------------------------------- /python3/tests/tests/scripts.execute_file/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Scripts; use GNATCOLL.Scripts; 2 | with GNATCOLL.Scripts.Python; use GNATCOLL.Scripts.Python; 3 | with Test_Common; 4 | 5 | function Test return Integer 6 | is 7 | Repository : Scripts_Repository := null; 8 | Python : Python_Scripting := null; 9 | Errors : Boolean; 10 | begin 11 | Test_Common.Set_Python_Home; 12 | 13 | Repository := new Scripts_Repository_Record; 14 | Register_Python_Scripting 15 | (Repo => Repository, 16 | Module => "Test"); 17 | Python := GNATCOLL.Scripts.Python.Python_Scripting 18 | (GNATCOLL.Scripts.Lookup_Scripting_Language 19 | (Repository, Python_Name)); 20 | 21 | Python.Execute_File 22 | (Filename => "simple_print.py", 23 | Show_Command => False, 24 | Errors => Errors); 25 | Python.Destroy; 26 | 27 | return 0; 28 | end Test; 29 | -------------------------------------------------------------------------------- /python3/tests/tests/scripts.execute_file/test.py: -------------------------------------------------------------------------------- 1 | from e3.os.process import Run 2 | import os 3 | import sys 4 | 5 | p = Run([os.path.join('obj', 'test')]) 6 | assert 'Hello from python binding' in p.out, f'output was\n:{p.out}' 7 | print('<=== TEST PASSED ===>') 8 | -------------------------------------------------------------------------------- /python3/tests/tests/scripts.execute_file/test.yaml: -------------------------------------------------------------------------------- 1 | description: test gnatcoll.scripts.execute_file 2 | goals: | 3 | The test spawn a python script using the GNATCOLL.Scripts function 4 | Execute_File. The test is using an intermediate test.py to launch 5 | it in order to ensure that I/O are redirected correctly. 6 | 7 | Note that with Python 3.x, if GNATCOLL.Scripts.Python.Destroy is 8 | not called some output might be lost when stdout is not a console. 9 | Indeed Python 3.x buffering strategy differs from Python 2.x 10 | (Issue detected in T701-014) 11 | -------------------------------------------------------------------------------- /readline/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - Readline 2 | ==================================================== 3 | 4 | This is the Readline component of the GNAT Components Collection. 5 | 6 | This component provides an interface to the readline library. 7 | This library provides support for interactive input from the user, 8 | providing nice key bindings to edit the current line (including support 9 | for backspace, move to beginning or end of line,...), as well as support 10 | for completion (via the key) and history (via up and down keys). 11 | 12 | Readline is licensed under the Full GNU General Public License. If you 13 | distribute a program using this package and the readline library, this 14 | program must be free software. 15 | 16 | When building, you need to pass an explicit option `--accept-gpl` 17 | to indicate that you accept and understand the terms of the license. 18 | 19 | Dependencies 20 | ------------ 21 | 22 | This component requires the following external components, that should be 23 | available on your system: 24 | 25 | - gprbuild 26 | - gnatcoll-core 27 | - readline 28 | -------------------------------------------------------------------------------- /readline/docs/Makefile: -------------------------------------------------------------------------------- 1 | include ../../docs-common/Makefile 2 | -------------------------------------------------------------------------------- /readline/docs/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | 3 | # GNATcoll Bindings - Readline documentation build configuration file 4 | 5 | # Load the base setup 6 | exec(open('../../docs-common/common_conf.py').read()) 7 | 8 | # General information about the project. 9 | project = u'GNATcoll Bindings - Readline' 10 | 11 | # Output file base name for HTML help builder. 12 | htmlhelp_basename = 'GNATcoll-Readline' 13 | 14 | # Grouping the document tree into LaTeX files. List of tuples 15 | # (source start file, target name, title, author, documentclass 16 | # [howto/manual]). 17 | latex_documents = [ 18 | ('index', 'GNATcoll-Readline.tex', 19 | u'GNATcoll Bindings - Readline Documentation', u'AdaCore', 'manual'), 20 | ] 21 | 22 | # One entry per manual page. List of tuples 23 | # (source start file, name, description, authors, manual section). 24 | man_pages = [ 25 | ('index', 'gnatcoll-readline', 26 | u'GNATcoll Bindings - Readline Documentation', 27 | [u'AdaCore'], 1) 28 | ] 29 | 30 | # Bibliographic Dublin Core info. 31 | epub_title = u'GNATcoll Bindings - Readline' 32 | -------------------------------------------------------------------------------- /readline/docs/index.rst: -------------------------------------------------------------------------------- 1 | GNATcoll Bindings - Readline: interactive command line 2 | ====================================================== 3 | 4 | .. highlight:: ada 5 | 6 | GNATcoll provides an interface to the ``readline`` library. 7 | 8 | .. sidebar:: License 9 | 10 | |Note| The GNU `readline` library is licensed under the terms of the GNU 11 | General Public License, version 3. This means that if you want to use 12 | Readline in a program that you release or distribute to anyone, the program 13 | must be free software and have a GPL-compatible license. 14 | 15 | You need to pass ``--accept-gpl`` to the ``setup.py`` script in order to 16 | indicate you understand the license of ``readline``. 17 | 18 | This component provides various features to enhance command line support in 19 | tools. In particular, it provides various keybindings to make editing more 20 | comfortable than ``Ada.Text_IO.Get_Line``. For instance, it is possible to use 21 | backspace to edit what you have just typed. It is also possible to move forward 22 | or backward by word, go to the start or end of line, ... 23 | 24 | ``readline`` also provides support for completion: by using the :kbd:`tab` key, 25 | users can get all possible completions for the current word. This behavior is 26 | controllable from Ada, where your application can provide the list of 27 | completions. 28 | 29 | Finally, readline comes with support for history. By using the :kbd:`up` and 30 | :kbd:`down` keys, the user can navigate the commands that were previously 31 | typed. It is also possible to preserve the history across sessions. 32 | 33 | See the ``GNATCOLL.Readline`` package for more information on this API. 34 | -------------------------------------------------------------------------------- /readline/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollReadline(SetupApp): 10 | name = 'gnatcoll_readline' 11 | project = 'gnatcoll_readline.gpr' 12 | description = 'GNATColl Readline bindings' 13 | 14 | def create(self): 15 | super(GNATCollReadline, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | self.build_cmd.add_argument( 22 | '--accept-gpl', 23 | help='accept the GPL license', 24 | action="store_true", 25 | default=False) 26 | 27 | def update_config(self, config, args): 28 | assert args.accept_gpl, "--accept-gpl is required" 29 | 30 | logging.info('%-26s %s', 31 | 'Libraries kind', ", ".join(config.data['library_types'])) 32 | 33 | # Set library version 34 | with open(os.path.join(config.source_dir, '..', 35 | 'version_information'), 'r') as fd: 36 | version = fd.read().strip() 37 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 38 | 39 | # Set build mode 40 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 41 | sub='gprbuild') 42 | logging.info('%-26s %s', 'Build mode', 43 | config.data['gprbuild']['BUILD']) 44 | 45 | # Set GNATCOLL_OS 46 | if 'darwin' in config.data['canonical_target']: 47 | gnatcoll_os = 'osx' 48 | elif 'windows' in config.data['canonical_target']: 49 | gnatcoll_os = 'windows' 50 | else: 51 | # Assume this is an Unix system 52 | gnatcoll_os = 'unix' 53 | config.set_data('GNATCOLL_OS', gnatcoll_os, sub='gprbuild') 54 | 55 | def variants(self, config, cmd): 56 | result = [] 57 | for library_type in config.data['library_types']: 58 | gpr_vars = {'LIBRARY_TYPE': library_type, 59 | 'XMLADA_BUILD': library_type, 60 | 'GPR_BUILD': library_type} 61 | if cmd == 'install': 62 | result.append((['--build-name=%s' % library_type, 63 | '--build-var=LIBRARY_TYPE'], 64 | gpr_vars)) 65 | else: 66 | result.append(([], gpr_vars)) 67 | return result 68 | 69 | 70 | if __name__ == '__main__': 71 | app = GNATCollReadline() 72 | sys.exit(app.run()) 73 | -------------------------------------------------------------------------------- /syslog/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - Syslog 2 | ================================================== 3 | 4 | This is the Syslog component of the GNAT Components Collection. 5 | 6 | Interface to syslog, the system logger on Unix systems. 7 | This package provides two levels of interfaces: 8 | - a low level interface to syslog (on Unix systems) 9 | - a higher level interface that can be used through GNAT.Traces. 10 | 11 | Dependencies 12 | ------------ 13 | 14 | This component requires the following external components, that should be 15 | available on your system: 16 | 17 | - gprbuild 18 | - gnatcoll-core 19 | - syslog 20 | -------------------------------------------------------------------------------- /syslog/docs/Makefile: -------------------------------------------------------------------------------- 1 | include ../../docs-common/Makefile 2 | -------------------------------------------------------------------------------- /syslog/docs/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | # 3 | # GNATcoll Bindings - Syslog documentation build configuration file 4 | 5 | # Load the base setup 6 | exec(open('../../docs-common/common_conf.py').read()) 7 | 8 | # General information about the project. 9 | project = u'GNATcoll Bindings - Syslog' 10 | 11 | # Output file base name for HTML help builder. 12 | htmlhelp_basename = 'GNATcoll-Syslogdoc' 13 | 14 | # Grouping the document tree into LaTeX files. List of tuples 15 | # (source start file, target name, title, author, documentclass 16 | # [howto/manual]). 17 | latex_documents = [ 18 | ('index', 'GNATcoll-Syslog.tex', u'GNATcoll Bindings - Syslog Documentation', 19 | u'AdaCore', 'manual'), 20 | ] 21 | 22 | # One entry per manual page. List of tuples 23 | # (source start file, name, description, authors, manual section). 24 | man_pages = [ 25 | ('index', 'gnatcoll-syslog', u'GNATcoll Bindings - Syslog Documentation', 26 | [u'AdaCore'], 1) 27 | ] 28 | 29 | 30 | # Bibliographic Dublin Core info. 31 | epub_title = u'GNATcoll Bindings - Syslog' 32 | -------------------------------------------------------------------------------- /syslog/docs/index.rst: -------------------------------------------------------------------------------- 1 | GNATcoll Bindings - Syslog 2 | ========================== 3 | 4 | Among the predefined streams, GNATColl gives access to the system logger 5 | ``syslog``. This is a standard utility on all Unix systems, but is not 6 | available on other systems. 7 | 8 | Activating support for syslog requires the following call in your application:: 9 | 10 | GNATCOLL.Traces.Syslog.Register_Syslog_Stream; 11 | 12 | After the above call, trace handles can be redirected to a stream named 13 | ``"syslog"``. 14 | 15 | The package ``GNATCOLL.Traces.Syslog`` also contains a low-level interface to 16 | syslog, which, although fully functional, you should probably not use, since 17 | that would make your code system-dependent. 18 | 19 | Syslog itself dispatches its output based on two criteria: the ``facility``, 20 | which indicates what application emitted the message, and where it should be 21 | filed, and the ``level`` which indicates the urgency level of the message. Both 22 | of these criteria can be specified in the ``GNATCOLL.Traces`` configuration 23 | file, as follows:: 24 | 25 | MODULE=yes >&syslog:user:error 26 | 27 | The above configuration will redirect to a facility called ``user``, with an 28 | urgency level ``error``. See the enumeration types in 29 | :file:`gnatcoll-traces-syslog.ads` for more information on valid facilities and 30 | levels. 31 | -------------------------------------------------------------------------------- /syslog/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollSyslog(SetupApp): 10 | name = 'gnatcoll_syslog' 11 | project = 'gnatcoll_syslog.gpr' 12 | description = 'GNATColl Syslog bindings' 13 | 14 | def create(self): 15 | super(GNATCollSyslog, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | # Set GNATCOLL_OS 39 | if 'darwin' in config.data['canonical_target']: 40 | gnatcoll_os = 'osx' 41 | elif 'windows' in config.data['canonical_target']: 42 | gnatcoll_os = 'windows' 43 | else: 44 | # Assume this is an Unix system 45 | gnatcoll_os = 'unix' 46 | config.set_data('GNATCOLL_OS', gnatcoll_os, sub='gprbuild') 47 | 48 | def variants(self, config, cmd): 49 | result = [] 50 | for library_type in config.data['library_types']: 51 | gpr_vars = {'LIBRARY_TYPE': library_type, 52 | 'XMLADA_BUILD': library_type, 53 | 'GPR_BUILD': library_type} 54 | if cmd == 'install': 55 | result.append((['--build-name=%s' % library_type, 56 | '--build-var=LIBRARY_TYPE'], 57 | gpr_vars)) 58 | else: 59 | result.append(([], gpr_vars)) 60 | return result 61 | 62 | 63 | if __name__ == '__main__': 64 | app = GNATCollSyslog() 65 | sys.exit(app.run()) 66 | -------------------------------------------------------------------------------- /syslog/syslog_support.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Syslog binding support 3 | * Copyright (C) 2017, AdaCore 4 | */ 5 | 6 | #include 7 | 8 | void 9 | syslog_wrapper(int priority, const char* msg) { 10 | syslog(priority, "%s", msg); 11 | } 12 | -------------------------------------------------------------------------------- /testsuite/drivers/basic.py: -------------------------------------------------------------------------------- 1 | import os 2 | 3 | from e3.fs import cp 4 | from e3.testsuite.result import TestStatus 5 | 6 | from drivers import gprbuild, GNATcollTestDriver 7 | from drivers.valgrind import check_call_valgrind 8 | 9 | 10 | class BasicTestDriver(GNATcollTestDriver): 11 | """Default GNATcoll testsuite driver. 12 | 13 | In order to declare a test: 14 | 15 | 1- Create a directory with a test.yaml inside 16 | 2- Add test sources in that directory 17 | 3- Add a main called test.adb that use support/test_assert.ads package. 18 | 4- Do not put test.gpr there, it breaks the test, if you need a project 19 | file for testing, name it something else. 20 | 5- If you need additional files for you test, list them in test.yaml: 21 | data: 22 | - "your_file1" 23 | - "your_file2" 24 | """ 25 | 26 | def add_test(self, dag): 27 | """Declare test workflow. 28 | 29 | The workflow is the following:: 30 | 31 | build --> check status 32 | 33 | :param dag: tree of test fragment to amend 34 | :type dag: e3.collection.dag.DAG 35 | """ 36 | self.add_fragment(dag, "build") 37 | self.add_fragment(dag, "check_run", after=["build"]) 38 | 39 | if "test_exe" not in self.test_env: 40 | self.test_env["test_exe"] = "obj/test" 41 | 42 | def build(self, previous_values, slot): 43 | """Build fragment.""" 44 | if self.test_env.get("no-coverage"): 45 | gpr_project_path = self.env.gnatcoll_prod_gpr_dir 46 | else: 47 | gpr_project_path = self.env.gnatcoll_gpr_dir 48 | return gprbuild( 49 | self, gcov=self.env.gcov, gpr_project_path=gpr_project_path 50 | ) 51 | 52 | def check_run(self, previous_values, slot): 53 | """Check status fragment.""" 54 | if not previous_values["build"]: 55 | return 56 | 57 | for data in self.test_env.get("data", []): 58 | cp( 59 | os.path.join(self.test_env["test_dir"], data), 60 | self.test_env["working_dir"], 61 | recursive=True, 62 | ) 63 | 64 | process = check_call_valgrind( 65 | self, 66 | [ 67 | os.path.join( 68 | self.test_env["working_dir"], self.test_env["test_exe"] 69 | ) 70 | ], 71 | ) 72 | if "<=== TEST PASSED ===>" not in process.out: 73 | self.result.set_status(TestStatus.FAIL) 74 | else: 75 | self.result.set_status(TestStatus.PASS) 76 | self.push_result() 77 | -------------------------------------------------------------------------------- /testsuite/drivers/valgrind.py: -------------------------------------------------------------------------------- 1 | from e3.testsuite.process import check_call 2 | 3 | 4 | def check_call_valgrind(driver, cmd, test_name=None, result=None, **kwargs): 5 | """ 6 | Wrapper for `e3.testsuite.process` that runs the process under Valgrind if 7 | this is a Valgrind-checked testsuite run. The process exit status will be 8 | 2 if Valgrind finds memory issues. 9 | """ 10 | if driver.env.valgrind: 11 | cmd = [ 12 | "valgrind", 13 | "-q", 14 | "--error-exitcode=2", 15 | "--leak-check=full", 16 | ] + cmd 17 | return check_call(driver, cmd, test_name, result, **kwargs) 18 | -------------------------------------------------------------------------------- /testsuite/e3-test.yaml: -------------------------------------------------------------------------------- 1 | main: run-tests 2 | default_args: [] 3 | -------------------------------------------------------------------------------- /testsuite/support/test.gpr: -------------------------------------------------------------------------------- 1 | -- Default project use for tests 2 | -- 3 | -- The scenario variable TEST_SOURCES is automatically set by the 4 | -- driver to point to the test sources. 5 | with "gnatcoll_core"; 6 | 7 | project Test is 8 | Test_Sources := External("TEST_SOURCES"); 9 | Support_Sources := External("SUPPORT_SOURCES"); 10 | for Source_Dirs use (".", Test_Sources, Support_Sources); 11 | for Main use ("test.adb"); 12 | for Languages use ("Ada", "C"); 13 | for Object_Dir use "obj"; 14 | 15 | package Compiler is 16 | for Default_Switches ("Ada") use ("-g"); 17 | end Compiler; 18 | end Test; 19 | -------------------------------------------------------------------------------- /testsuite/support/test_assert.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Ada.Text_IO; 25 | 26 | package body Test_Assert is 27 | package IO renames Ada.Text_IO; 28 | 29 | ------------ 30 | -- Assert -- 31 | ------------ 32 | 33 | procedure Assert 34 | (Success : Boolean; 35 | Msg : String := ""; 36 | Location : String := SI.Source_Location) 37 | is 38 | begin 39 | IO.Put (Location & ": "); 40 | if Success then 41 | IO.Put ("PASSED:"); 42 | else 43 | IO.Put ("FAILED:"); 44 | Final_Status := 1; 45 | end if; 46 | if Msg'Length > 0 then 47 | IO.Put (" "); 48 | IO.Put (Msg); 49 | end if; 50 | IO.New_Line; 51 | end Assert; 52 | 53 | ------------ 54 | -- Assert -- 55 | ------------ 56 | 57 | procedure Assert 58 | (Left, Right : String; 59 | Msg : String := ""; 60 | Location : String := SI.Source_Location) 61 | is 62 | Success : constant Boolean := Left = Right; 63 | begin 64 | Assert (Success, Msg, Location); 65 | if not Success then 66 | if Right'Length > 0 then 67 | IO.Put_Line ("expected: " & Right); 68 | else 69 | IO.Put_Line ("expected empty string"); 70 | end if; 71 | 72 | if Left'Length > 0 then 73 | IO.Put_Line ("got: " & Left); 74 | else 75 | IO.Put_Line ("got empty string"); 76 | end if; 77 | end if; 78 | end Assert; 79 | 80 | ------------ 81 | -- Report -- 82 | ------------ 83 | 84 | function Report return Natural is 85 | begin 86 | if Final_Status = 0 then 87 | IO.Put_Line ("<=== TEST PASSED ===>"); 88 | else 89 | IO.PUT_Line ("<=== TEST FAILED ===>"); 90 | end if; 91 | return Final_Status; 92 | end Report; 93 | 94 | end Test_Assert; 95 | -------------------------------------------------------------------------------- /testsuite/support/test_assert.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | -- Helper package to implement tests that comply with the expectations 25 | -- of the default test driver. 26 | 27 | with GNAT.Source_Info; 28 | 29 | package Test_Assert is 30 | 31 | package SI renames GNAT.Source_Info; 32 | 33 | Final_Status : Natural := 0; 34 | 35 | procedure Assert 36 | (Success : Boolean; 37 | Msg : String := ""; 38 | Location : String := SI.Source_Location); 39 | -- If Success is True then test case is considered PASSED, otherwise 40 | -- the test status is FAILED and Final_Status set to 1. 41 | 42 | procedure Assert 43 | (Left, Right : String; 44 | Msg : String := ""; 45 | Location : String := SI.Source_Location); 46 | -- If Left = Right then test case is considered PASSED, otherwise 47 | -- the test status is FAILED and Final_Status set to 1. 48 | 49 | function Report return Natural; 50 | -- Report should be called the following way at the end of a test 51 | -- program main function: 52 | -- 53 | -- return Report; 54 | -- 55 | -- Testsuite driver will consider a test to PASS if all the 56 | -- following conditions are met: 57 | -- 58 | -- * test program exit with status 0 59 | -- * all assert calls did succeed 60 | -- * test program display the message "<=== TEST PASSED ===>" 61 | end Test_Assert; 62 | -------------------------------------------------------------------------------- /testsuite/tests/coders/save_streams.adb: -------------------------------------------------------------------------------- 1 | package body Save_Streams is 2 | 3 | ---------- 4 | -- Read -- 5 | ---------- 6 | 7 | overriding procedure Read 8 | (Stream : in out Stream_Type; 9 | Item : out Stream_Element_Array; 10 | Last : out Stream_Element_Offset) 11 | is 12 | Length : constant Integer := 13 | Natural'Min (Item'Length, Stream.Buffer.Length - Stream.Position); 14 | Target : String (1 .. Integer'Max (Length, 0)); 15 | for Target'Address use Item'Address; 16 | begin 17 | if Target = "" then 18 | Last := Item'First - 1; 19 | return; 20 | end if; 21 | 22 | Target := To_String 23 | (Stream.Buffer.Slice 24 | (Stream.Position + 1, Stream.Position + Length)); 25 | Stream.Position := Stream.Position + Length; 26 | Last := Item'First + Stream_Element_Offset (Length) - 1; 27 | end Read; 28 | 29 | ----------- 30 | -- Write -- 31 | ----------- 32 | 33 | overriding procedure Write 34 | (Stream : in out Stream_Type; 35 | Item : Stream_Element_Array) 36 | is 37 | Source : String (1 .. Item'Length); 38 | for Source'Address use Item'Address; 39 | begin 40 | Stream.Buffer.Append (Source); 41 | end Write; 42 | 43 | ----------- 44 | -- Clear -- 45 | ----------- 46 | 47 | procedure Clear (Stream : in out Stream_Type) is 48 | begin 49 | Stream.Buffer.Clear; 50 | Stream.Reset; 51 | end Clear; 52 | 53 | ----------------------- 54 | -- Remove_Last_Bytes -- 55 | ----------------------- 56 | 57 | procedure Remove_Last_Bytes 58 | (Stream : in out Stream_Type; Count : Natural) is 59 | begin 60 | Stream.Buffer := Stream.Buffer.Head (Stream.Buffer.Length - Count); 61 | end Remove_Last_Bytes; 62 | 63 | ----------- 64 | -- Reset -- 65 | ----------- 66 | 67 | procedure Reset (Stream : in out Stream_Type) is 68 | begin 69 | Stream.Position := 0; 70 | end Reset; 71 | 72 | ----------- 73 | -- Slice -- 74 | ----------- 75 | 76 | function Slice 77 | (Stream : Stream_Type; Low : Positive; High : Natural) return String is 78 | begin 79 | return To_String (Stream.Buffer.Slice (Low, High)); 80 | end Slice; 81 | 82 | end Save_Streams; 83 | -------------------------------------------------------------------------------- /testsuite/tests/coders/save_streams.ads: -------------------------------------------------------------------------------- 1 | with Ada.Streams; use Ada.Streams; 2 | with GNATCOLL.Strings; use GNATCOLL.Strings; 3 | 4 | package Save_Streams is 5 | 6 | type Stream_Type is new Root_Stream_Type with private; 7 | -- Stream reading the data which was wrote there before 8 | 9 | overriding procedure Read 10 | (Stream : in out Stream_Type; 11 | Item : out Stream_Element_Array; 12 | Last : out Stream_Element_Offset); 13 | 14 | overriding procedure Write 15 | (Stream : in out Stream_Type; 16 | Item : Stream_Element_Array); 17 | 18 | procedure Reset (Stream : in out Stream_Type); 19 | -- Reset read position to the start of data 20 | 21 | procedure Clear (Stream : in out Stream_Type); 22 | -- Clear all internal written data from stream 23 | 24 | function Slice 25 | (Stream : Stream_Type; Low : Positive; High : Natural) return String; 26 | 27 | procedure Remove_Last_Bytes (Stream : in out Stream_Type; Count : Natural); 28 | 29 | private 30 | 31 | type Stream_Type is new Root_Stream_Type with record 32 | Position : Natural := 0; 33 | Buffer : XString; 34 | end record; 35 | 36 | end Save_Streams; 37 | -------------------------------------------------------------------------------- /testsuite/tests/coders/test.gpr: -------------------------------------------------------------------------------- 1 | with "gnatcoll_core"; 2 | with "gnatcoll_lzma"; 3 | with "gnatcoll_zlib"; 4 | 5 | project Test is 6 | for Main use ("test.adb"); 7 | for Source_Dirs use (".", "../../support"); 8 | for Object_Dir use "obj"; 9 | 10 | package Compiler is 11 | for Switches ("Ada") use ("-g", "-gnateE"); 12 | end Compiler; 13 | 14 | package Linker is 15 | for Switches ("Ada") use ("-g"); 16 | end Linker; 17 | 18 | package Binder is 19 | for Switches ("Ada") use ("-E"); 20 | end Binder; 21 | 22 | end Test; 23 | -------------------------------------------------------------------------------- /testsuite/tests/coders/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.Coders 2 | -------------------------------------------------------------------------------- /testsuite/tests/coders/test_streams.adb: -------------------------------------------------------------------------------- 1 | with Ada.Text_IO; use Ada.Text_IO; 2 | 3 | package body Test_Streams is 4 | 5 | function Next_Stream_Element 6 | (G : in out Generator; Remain : in out XString) return Stream_Element; 7 | 8 | ------------------------- 9 | -- Next_Stream_Element -- 10 | ------------------------- 11 | 12 | function Next_Stream_Element 13 | (G : in out Generator; Remain : in out XString) return Stream_Element 14 | is 15 | S : State; 16 | E : Stream_Element; 17 | begin 18 | if Remain.Is_Empty then 19 | Remain := To_XString (ASCII.LF & Float'Image (Random (G))); 20 | Save (G, S); 21 | Remain.Append (Image (S) (1 .. 100)); 22 | end if; 23 | 24 | E := Character'Pos (Remain (Remain.Length)); 25 | Remain.Slice (1, Remain.Length - 1); 26 | return E; 27 | end Next_Stream_Element; 28 | 29 | --------------- 30 | -- Set_Limit -- 31 | --------------- 32 | 33 | procedure Set_Limit 34 | (Stream : in out Stream_Type; Limit : Stream_Element_Count) is 35 | begin 36 | Stream.Limit := Limit; 37 | end Set_Limit; 38 | 39 | ---------- 40 | -- Read -- 41 | ---------- 42 | 43 | overriding procedure Read 44 | (Stream : in out Stream_Type; 45 | Item : out Stream_Element_Array; 46 | Last : out Stream_Element_Offset) is 47 | begin 48 | if not Stream.Read_Started then 49 | Stream.Read_Started := True; 50 | Reset (Stream.Read_Generator); 51 | Save (Stream.Read_Generator, Stream.Init_State); 52 | end if; 53 | 54 | Last := Item'First - 1; 55 | 56 | while Last < Item'Last and then Stream.Limit > 0 loop 57 | Last := Last + 1; 58 | Stream.Limit := Stream.Limit - 1; 59 | 60 | Item (Last) := Next_Stream_Element 61 | (Stream.Read_Generator, Stream.Read_Remain); 62 | end loop; 63 | end Read; 64 | 65 | ----------- 66 | -- Write -- 67 | ----------- 68 | 69 | overriding procedure Write 70 | (Stream : in out Stream_Type; 71 | Item : Stream_Element_Array) is 72 | begin 73 | if not Stream.Write_Started then 74 | Stream.Write_Started := True; 75 | Reset (Stream.Write_Generator, Stream.Init_State); 76 | end if; 77 | 78 | for J in Item'Range loop 79 | if Item (J) /= Next_Stream_Element 80 | (Stream.Write_Generator, Stream.Write_Remain) 81 | then 82 | Put_Line ("Random initialization state to restore the bug:"); 83 | Put_Line (Image (Stream.Init_State)); 84 | raise Program_Error with "Data differ"; 85 | end if; 86 | end loop; 87 | end Write; 88 | 89 | end Test_Streams; 90 | -------------------------------------------------------------------------------- /testsuite/tests/coders/test_streams.ads: -------------------------------------------------------------------------------- 1 | with Ada.Streams; use Ada.Streams; 2 | with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; 3 | with GNATCOLL.Strings; use GNATCOLL.Strings; 4 | 5 | package Test_Streams is 6 | 7 | type Stream_Type is new Root_Stream_Type with private; 8 | -- Stream checking that all data taken from Read have to be the same 9 | -- accepted by Write. 10 | 11 | overriding procedure Read 12 | (Stream : in out Stream_Type; 13 | Item : out Stream_Element_Array; 14 | Last : out Stream_Element_Offset); 15 | 16 | overriding procedure Write 17 | (Stream : in out Stream_Type; 18 | Item : Stream_Element_Array); 19 | 20 | procedure Set_Limit 21 | (Stream : in out Stream_Type; Limit : Stream_Element_Count); 22 | -- Set the data limit to get from Read routine. 23 | 24 | private 25 | 26 | type Stream_Type is new Root_Stream_Type with record 27 | Read_Started : Boolean := False; 28 | Write_Started : Boolean := False; 29 | Limit : Stream_Element_Count := Stream_Element_Count'Last; 30 | Read_Generator : Generator; 31 | Write_Generator : Generator; 32 | Init_State : State; 33 | Read_Remain : XString; 34 | Write_Remain : XString; 35 | end record; 36 | 37 | 38 | end Test_Streams; 39 | -------------------------------------------------------------------------------- /testsuite/tests/cpp_strings/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.CPP.Strings 2 | components: 3 | - cpp 4 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2015-2023, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Test_Image, Test_Div, Test_Eq, Test_Pow, Test_Mod, Test_Rem, Test_Swap, 25 | Test_Roots, Test_GCD, Test_Operators, Test_Bitwise, Test_Rationals; 26 | with Test_Assert; 27 | 28 | function Test return Integer is 29 | begin 30 | Test_Eq; 31 | Test_Image; 32 | Test_Swap; 33 | Test_Roots; 34 | Test_Pow; 35 | Test_Div; 36 | Test_Rem; 37 | Test_Mod; 38 | Test_GCD; 39 | Test_Operators; 40 | Test_Bitwise; 41 | Test_Rationals; 42 | 43 | return Test_Assert.Report; 44 | end Test; 45 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.GMP 2 | components: 3 | - gmp 4 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_div.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers; 25 | with Test_Assert; use Test_Assert; 26 | 27 | procedure Test_Div is 28 | 29 | Q, N, D : Big_Integer; 30 | 31 | Dividend : constant String := 32 | "1000000000000000000000000000000000000000000000000000000000000000000000"; 33 | 34 | Divisor : constant String := Dividend (1 .. Dividend'Length - 1); 35 | 36 | Quotient : constant String := Dividend 37 | (1 .. Dividend'Length - Divisor'Length + 1); 38 | 39 | begin 40 | Set (N, Dividend); 41 | Set (D, Divisor); 42 | Divide (Q, N, D); 43 | 44 | Assert (Image (Q), Quotient, "test_div 1"); 45 | 46 | Set (Q, To => N / D); 47 | 48 | Assert (Image (Q), Quotient, "test_div 2"); 49 | end Test_Div; 50 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_eq.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers; 25 | 26 | use GNATCOLL.GMP; -- for numeric types 27 | use GNATCOLL.GMP.Integers; 28 | with Test_Assert; use Test_Assert; 29 | 30 | 31 | procedure Test_Eq is 32 | 33 | D, N : Big_Integer; 34 | 35 | begin 36 | Set (N, "14"); 37 | Set (D, 28 / 2); 38 | 39 | Assert (N = D, "test_eq 1"); 40 | 41 | Assert (N = 14, "test_eq 2 "); 42 | 43 | Assert (14 = N, "test_eq 3"); 44 | end Test_Eq; 45 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_gcd.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers.Number_Theoretic; 25 | 26 | use GNATCOLL.GMP.Integers.Number_Theoretic; 27 | use GNATCOLL.GMP.Integers; 28 | with Test_Assert; use Test_Assert; 29 | 30 | procedure Test_GCD is 31 | 32 | A, B, C : Big_Integer; 33 | 34 | begin 35 | Set (A, "42"); 36 | Set (B, "56"); 37 | 38 | Get_GCD (Input1 => A, Input2 => B, Output => C); 39 | 40 | Assert (C = 14, "test_gcd"); 41 | end Test_GCD; 42 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_image.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers; 25 | with Test_Assert; use Test_Assert; 26 | 27 | procedure Test_Image is 28 | 29 | N : Big_Integer; 30 | 31 | Input : constant String := "14000000000000000000000" & 32 | "000000000000000000000001"; 33 | 34 | Negated_Input : constant String := '-' & Input; 35 | 36 | Input_Base_2 : constant String := 37 | "1001110011110010000001111001000111010111100010000101010100011010011" & 38 | "0000111101110001100000010011011111001001100000000000000000000000000" & 39 | "00000000000000000001"; 40 | 41 | Input_Base_3 : constant String := 42 | "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; 43 | 44 | begin 45 | Set (N, Input); 46 | Assert (Image (N), Input, "test_image 1"); 47 | 48 | Negate (N); 49 | Assert (Image (N), Negated_Input, "test_image 2"); 50 | 51 | Set (N, Input); 52 | Assert (Image (N, Base => 2), Input_Base_2, "test_image 3"); 53 | 54 | for J in Input_Base_3'Range loop 55 | declare 56 | Img : constant String := Input_Base_3 (1 .. J); 57 | Img0 : constant String := Input_Base_3 (1 .. J) & '0'; 58 | Base : constant Positive := Img0'Length; 59 | begin 60 | Set (N, Img, Base => GNATCOLL.GMP.Int (Base)); 61 | 62 | Assert 63 | (Img, Image (N, (if J < 36 then -Base else Base)), 64 | "test_image -" & J'Img); 65 | 66 | Set (N, Img0, Base => GNATCOLL.GMP.Int (Base)); 67 | 68 | Assert 69 | (Img0, Image (N, (if J < 36 then -Base else Base)), 70 | "test_image: " & J'Img); 71 | end; 72 | end loop; 73 | end Test_Image; 74 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_pow.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers; 25 | with Test_Assert; use Test_Assert; 26 | 27 | procedure Test_Pow is 28 | 29 | A, B : Big_Integer; 30 | 31 | begin 32 | Set (A, "2"); 33 | Set (B, A ** 5); 34 | Assert (B = 32, "test_pow: 2**5 = 32"); 35 | 36 | Set (A, 100); 37 | Raise_To_N (A, 5); 38 | Assert (Image (A), "10000000000", "test_pow 100**5 = 10000000000"); 39 | 40 | end Test_Pow; 41 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_roots.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers.Root_Extraction; 25 | 26 | use GNATCOLL.GMP.Integers; 27 | use GNATCOLL.GMP.Integers.Root_Extraction; 28 | 29 | with Test_Assert; use Test_Assert; 30 | 31 | procedure Test_Roots is 32 | 33 | A, B : Big_Integer; 34 | 35 | Root_Value : constant := 99_999; 36 | Raised_Value : constant String := "99995000000000000000000000000000"; 37 | Was_Exact : Boolean; 38 | 39 | begin 40 | Set (A, "144"); 41 | Get_SQRT (A, Into => B); 42 | 43 | Assert (B = 12, "test_roots: sqrt of 144 = 12"); 44 | 45 | Set (A, To => Root_Value); 46 | Raise_To_N (A, 5); 47 | Get_Nth_Root (A, N => 5, Into => B, Exact => Was_Exact); 48 | 49 | Assert 50 | (B = Root_Value, 51 | "test_roots: 5th root of " & Raised_Value & " = " & Root_Value'Img); 52 | 53 | Assert 54 | (Was_Exact, "test_roots: 5th root of " & Raised_Value & " is exact"); 55 | 56 | end Test_Roots; 57 | -------------------------------------------------------------------------------- /testsuite/tests/gmp/test_swap.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2009-2018, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers; 25 | with GNATCOLL.GMP.Integers.Misc; use GNATCOLL.GMP.Integers.Misc; 26 | with Test_Assert; use Test_Assert; 27 | 28 | procedure Test_Swap is 29 | 30 | A, B, A_Copy, B_Copy : Big_Integer; 31 | 32 | begin 33 | Set (A, "123456789012345678901234567890"); -- arbitrary value 34 | Set (A_Copy, To => A); 35 | 36 | Set (B, "987654321987654321987654321"); -- arbitrary value 37 | Set (B_Copy, To => B); 38 | 39 | Swap (A, B); 40 | 41 | Assert (A = B_Copy, "test_swap: A = original B"); 42 | 43 | Assert (B = A_Copy, "test_swap: B = original A"); 44 | 45 | end Test_Swap; 46 | -------------------------------------------------------------------------------- /testsuite/tests/iconv/bad_charset/test.adb: -------------------------------------------------------------------------------- 1 | with GNATCOLL.Iconv; 2 | with Test_Assert; 3 | 4 | function Test return Integer is 5 | package Iconv renames GNATCOLL.Iconv; 6 | package A renames Test_Assert; 7 | 8 | St : Iconv.Iconv_T; 9 | Success : Boolean := False; 10 | begin 11 | begin 12 | St := Iconv.Iconv_Open ("nonexistent", "nonexistent"); 13 | exception 14 | when Iconv.Unsupported_Conversion => 15 | Success := True; 16 | end; 17 | 18 | A.Assert (Success, Msg => "handling of bad charset"); 19 | return A.Report; 20 | end Test; 21 | -------------------------------------------------------------------------------- /testsuite/tests/iconv/bad_charset/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.Iconv (bad charset) 2 | components: 3 | - iconv 4 | -------------------------------------------------------------------------------- /testsuite/tests/iconv/iconv1/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.Iconv 2 | components: 3 | - iconv 4 | -------------------------------------------------------------------------------- /testsuite/tests/omp/sort/test.adb: -------------------------------------------------------------------------------- 1 | with Ada.Text_IO; use Ada.Text_IO; 2 | with Ada.Calendar; use Ada.Calendar; 3 | with GNATCOLL.OMP.Generic_Array_Sort; 4 | with Ada.Numerics.Discrete_Random; 5 | with Test_Assert; use Test_Assert; 6 | 7 | function Test return Integer is 8 | Timing : constant Boolean := False; 9 | 10 | type Index is range 1 .. 5_000_000; 11 | type My_Array is array (Index range <>) of Integer; 12 | procedure My_Sort is new GNATCOLL.OMP.Generic_Array_Sort 13 | (Index, Integer, My_Array); 14 | 15 | package Random is new Ada.Numerics.Discrete_Random (Integer); 16 | 17 | procedure Randomize (Container : in out My_Array) is 18 | Seed : Random.Generator; 19 | begin 20 | for J in Container'Range loop 21 | Container (J) := Random.Random (Seed); 22 | end loop; 23 | end Randomize; 24 | 25 | procedure Check_Array_Sorted (Container : My_Array) is 26 | begin 27 | for J in Container'First + 1 .. Container'Last loop 28 | if Container (J) < Container (J - 1) then 29 | Assert (False); 30 | end if; 31 | end loop; 32 | end Check_Array_Sorted; 33 | 34 | Arr : access My_Array := new My_Array (Index); 35 | Start : Time; 36 | Time : Duration; 37 | 38 | begin 39 | Randomize (Arr.all); 40 | 41 | Start := Clock; 42 | My_Sort (Arr.all); 43 | Time := Clock - Start; 44 | Check_Array_Sorted (Arr.all); 45 | 46 | if Timing then 47 | Put_Line ("time: " & Time'Image); 48 | end if; 49 | 50 | return Report; 51 | end Test; 52 | -------------------------------------------------------------------------------- /testsuite/tests/omp/sort/test.gpr: -------------------------------------------------------------------------------- 1 | with "gnatcoll_omp"; 2 | 3 | project Test is 4 | for Main use ("test.adb"); 5 | for Source_Dirs use (".", "../../../support"); 6 | for Object_Dir use "obj"; 7 | 8 | package Compiler is 9 | for Switches ("Ada") use ("-g", "-gnateE"); 10 | end Compiler; 11 | 12 | package Linker is 13 | for Switches ("Ada") use ("-g"); 14 | end Linker; 15 | 16 | package Binder is 17 | for Switches ("Ada") use ("-E"); 18 | end Binder; 19 | 20 | end Test; 21 | -------------------------------------------------------------------------------- /testsuite/tests/omp/sort/test.yaml: -------------------------------------------------------------------------------- 1 | description: Test for GNATCOLL.OMP parallel sort 2 | components: 3 | - omp 4 | 5 | -------------------------------------------------------------------------------- /version_information: -------------------------------------------------------------------------------- 1 | 0.0 2 | -------------------------------------------------------------------------------- /zlib/setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import logging 3 | import os 4 | import sys 5 | sys.path.append(os.path.dirname(os.path.dirname(os.path.abspath(__file__)))) 6 | from setup_support import SetupApp 7 | 8 | 9 | class GNATCollZLib(SetupApp): 10 | name = 'gnatcoll_zlib' 11 | project = 'gnatcoll_zlib.gpr' 12 | description = 'GNATColl ZLib bindings' 13 | 14 | def create(self): 15 | super(GNATCollZLib, self).create() 16 | self.build_cmd.add_argument( 17 | '--debug', 18 | help='build project in debug mode', 19 | action="store_true", 20 | default=False) 21 | 22 | def update_config(self, config, args): 23 | logging.info('%-26s %s', 24 | 'Libraries kind', ", ".join(config.data['library_types'])) 25 | 26 | # Set library version 27 | with open(os.path.join(config.source_dir, '..', 28 | 'version_information'), 'r') as fd: 29 | version = fd.read().strip() 30 | config.set_data('GNATCOLL_VERSION', version, sub='gprbuild') 31 | 32 | # Set build mode 33 | config.set_data('BUILD', 'DEBUG' if args.debug else 'PROD', 34 | sub='gprbuild') 35 | logging.info('%-26s %s', 'Build mode', 36 | config.data['gprbuild']['BUILD']) 37 | 38 | def variants(self, config, cmd): 39 | result = [] 40 | for library_type in config.data['library_types']: 41 | gpr_vars = {'LIBRARY_TYPE': library_type, 42 | 'GPR_BUILD': library_type} 43 | if cmd == 'install': 44 | result.append((['--build-name=%s' % library_type, 45 | '--build-var=LIBRARY_TYPE'], 46 | gpr_vars)) 47 | else: 48 | result.append(([], gpr_vars)) 49 | return result 50 | 51 | 52 | if __name__ == '__main__': 53 | app = GNATCollZLib() 54 | sys.exit(app.run()) 55 | -------------------------------------------------------------------------------- /zstd/README.md: -------------------------------------------------------------------------------- 1 | The GNAT Components Collection (GNATCOLL) - ZSTD 2 | ================================================ 3 | 4 | This is the ZSTD component of the GNAT Components Collection. 5 | 6 | It is an interface to the ZSTD Compression/Decompression library 7 | 8 | Dependencies 9 | ------------ 10 | 11 | This component requires the following external components, that should be 12 | available on your system: 13 | 14 | - python 3.x: needed to launch the configuration script 15 | - e3-testsuite python package (optional): to launch the testsuite 16 | - gprbuild: builder for the project 17 | - gnatcoll-core library: dependency 18 | - zstd library >= 1.5.0: dependency 19 | 20 | 21 | Project Structure 22 | ----------------- 23 | 24 | - config/gnatcoll_zstd_constants.gpr: contains default values for scenario 25 | variables that are computed by the configuration script. 26 | - gnatcoll_zstd.gpr: project to be withed in order to use the library 27 | - gnatcoll_zstd.gpr.py: configuration script 28 | - README.md: the present file 29 | - src/: library sources 30 | - src/gnatcoll-zstd.ads: low-level binding to ZSTD C API 31 | - src/gnatcoll-zstd-streams.ads: low-level binding to ZSTD stream C API 32 | - src/gnatcoll-zstd-controlled.ads: higher level binding that use 33 | controlled objects for context and raise Ada exceptions in case of error. 34 | - src/gnatcoll-coders-zstd.ads: Ada stream support using GNATCOLL.Coders 35 | - testsuite/: testsuite 36 | - run-tests 37 | 38 | 39 | Building 40 | -------- 41 | 42 | The simplest way to build and install the project is to run the following 43 | command: 44 | 45 | $ cd 46 | $ /gnatcoll_zstd.gpr.py build --prefix= --install 47 | 48 | The command will build both static and shared version of the library and install 49 | it in **INSTALL_DIR** 50 | 51 | The Python script provides more options. For each command help can displayed by 52 | doing: 53 | 54 | $ gnatcoll_zstd.gpr.py COMMAND --help 55 | -------------------------------------------------------------------------------- /zstd/config/gnatcoll_zstd_constants.gpr: -------------------------------------------------------------------------------- 1 | abstract project GNATCOLL_Zstd_Constants is 2 | GNATCOLL_ZSTD_VERSION_DEFAULT := "0.0"; 3 | GNATCOLL_ZSTD_OS_DEFAULT := "unix"; 4 | GNATCOLL_ZSTD_BUILD_MODE_DEFAULT := "PROD"; 5 | end GNATCOLL_Zstd_Constants; 6 | -------------------------------------------------------------------------------- /zstd/gnatcoll_zstd.gpr.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | from __future__ import annotations 3 | from typing import TYPE_CHECKING 4 | import sys 5 | import os 6 | 7 | # Support code is located in parent directory 8 | SOURCE_DIR = os.path.dirname(os.path.abspath(__file__)) 9 | sys.path.append(os.path.dirname(SOURCE_DIR)) 10 | 11 | from gprproject import BuilderApp 12 | 13 | if TYPE_CHECKING: 14 | import argparse 15 | from gprproject.gprbuild import GPRTool 16 | 17 | class GNATCOLLZstd(BuilderApp): 18 | project_file = os.path.join(SOURCE_DIR, "gnatcoll_zstd.gpr") 19 | description = "GNATCOLL ZSTD binding" 20 | constants_project_file = os.path.join(SOURCE_DIR, "config", "gnatcoll_zstd_constants.gpr") 21 | 22 | def add_arguments(self, parser: argparse.ArgumentParser) -> None: 23 | parser.add_argument("--build", choices=["DEBUG", "PROD"], default="PROD") 24 | parser.add_argument("--enable-shared", choices=["yes", "no"], default="yes") 25 | 26 | def adjust_config(self, gpr: GPRTool, args: argparse.Namespace) -> None: 27 | with open(os.path.join(SOURCE_DIR, "..", "version_information")) as fd: 28 | version = fd.read().strip() 29 | gpr.set_variable("GNATCOLL_ZSTD_VERSION", version) 30 | 31 | if "windows" in gpr.target: 32 | gnatcoll_os = "windows" 33 | elif "darwin" in gpr.target: 34 | gnatcoll_os = "osx" 35 | else: 36 | gnatcoll_os = "unix" 37 | gpr.set_variable("GNATCOLL_ZSTD_OS", gnatcoll_os) 38 | gpr.set_variable("GNATCOLL_ZSTD_BUILD_MODE", args.build) 39 | 40 | if args.gnatcov: 41 | gpr.set_variable("LIBRARY_TYPE", "static") 42 | else: 43 | gpr.variants_var = "LIBRARY_TYPE" 44 | if args.enable_shared == "yes": 45 | gpr.variants_values = ["static", "relocatable", "static-pic"] 46 | else: 47 | gpr.variants_values = ["static"] 48 | 49 | if __name__ == "__main__": 50 | app = GNATCOLLZstd() 51 | sys.exit(app.run()) 52 | -------------------------------------------------------------------------------- /zstd/src/gnatcoll-zstd.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Interfaces.C.Strings; 25 | 26 | package body GNATCOLL.ZSTD is 27 | use type C.unsigned; 28 | 29 | package CStrings renames Interfaces.C.Strings; 30 | 31 | ------------------------- 32 | -- ZSTD_Get_Error_Name -- 33 | ------------------------- 34 | 35 | function ZSTD_Get_Error_Name (Code : C.size_t) return String is 36 | function Internal (Code : C.size_t) return CStrings.chars_ptr; 37 | pragma Import (C, Internal, "ZSTD_getErrorName"); 38 | begin 39 | return CStrings.Value (Internal (Code)); 40 | end ZSTD_Get_Error_Name; 41 | 42 | ------------------- 43 | -- ZSTD_Is_Error -- 44 | ------------------- 45 | 46 | function ZSTD_Is_Error (Code : C.size_t) return Boolean is 47 | function Internal (Code : C.size_t) return C.unsigned; 48 | pragma Import (C, Internal, "ZSTD_isError"); 49 | begin 50 | return Internal (Code) > 0; 51 | end ZSTD_Is_Error; 52 | 53 | ------------------------- 54 | -- ZSTD_Version_String -- 55 | ------------------------- 56 | 57 | function ZSTD_Version_String return String is 58 | function Internal return CStrings.chars_ptr; 59 | pragma Import (C, Internal, "ZSTD_versionString"); 60 | begin 61 | return CStrings.Value (Internal); 62 | end ZSTD_Version_String; 63 | 64 | end GNATCOLL.ZSTD; 65 | -------------------------------------------------------------------------------- /zstd/testsuite/run-tests: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | from __future__ import annotations 3 | import sys 4 | import os 5 | 6 | ROOT_DIR = os.path.dirname(os.path.abspath(__file__)) 7 | sys.path.insert(0, os.path.dirname(os.path.dirname(ROOT_DIR))) 8 | 9 | from gprproject.testsuite import LibTestsuite 10 | 11 | class ZstdTestsuite(LibTestsuite): 12 | @property 13 | def default_withed_projects(self) -> list[str]: 14 | return ["gnatcoll_zstd"] 15 | 16 | if __name__ == '__main__': 17 | ZstdTestsuite.main(os.path.dirname(__file__)) 18 | -------------------------------------------------------------------------------- /zstd/testsuite/support/save_streams.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Ada.Streams; use Ada.Streams; 25 | with GNATCOLL.Strings; use GNATCOLL.Strings; 26 | 27 | package Save_Streams is 28 | 29 | type Stream_Type is new Root_Stream_Type with private; 30 | -- Stream reading the data which was wrote there before 31 | 32 | overriding 33 | procedure Read 34 | (Stream : in out Stream_Type; 35 | Item : out Stream_Element_Array; 36 | Last : out Stream_Element_Offset); 37 | 38 | overriding 39 | procedure Write (Stream : in out Stream_Type; Item : Stream_Element_Array); 40 | 41 | procedure Reset (Stream : in out Stream_Type); 42 | -- Reset read position to the start of data 43 | 44 | procedure Clear (Stream : in out Stream_Type); 45 | -- Clear all internal written data from stream 46 | 47 | function Slice 48 | (Stream : Stream_Type; Low : Positive; High : Natural) return String; 49 | 50 | procedure Remove_Last_Bytes (Stream : in out Stream_Type; Count : Natural); 51 | 52 | private 53 | 54 | type Stream_Type is new Root_Stream_Type with record 55 | Position : Natural := 0; 56 | Buffer : XString; 57 | end record; 58 | 59 | end Save_Streams; 60 | -------------------------------------------------------------------------------- /zstd/testsuite/support/test_streams.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Ada.Streams; use Ada.Streams; 25 | with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; 26 | with GNATCOLL.Strings; use GNATCOLL.Strings; 27 | 28 | package Test_Streams is 29 | 30 | type Stream_Type is new Root_Stream_Type with private; 31 | -- Stream checking that all data taken from Read have to be the same 32 | -- accepted by Write. 33 | 34 | overriding 35 | procedure Read 36 | (Stream : in out Stream_Type; 37 | Item : out Stream_Element_Array; 38 | Last : out Stream_Element_Offset); 39 | 40 | overriding 41 | procedure Write (Stream : in out Stream_Type; Item : Stream_Element_Array); 42 | 43 | procedure Set_Limit 44 | (Stream : in out Stream_Type; Limit : Stream_Element_Count); 45 | -- Set the data limit to get from Read routine. 46 | 47 | private 48 | 49 | type Stream_Type is new Root_Stream_Type with record 50 | Read_Started : Boolean := False; 51 | Write_Started : Boolean := False; 52 | Limit : Stream_Element_Count := Stream_Element_Count'Last; 53 | Read_Generator : Generator; 54 | Write_Generator : Generator; 55 | Init_State : State; 56 | Read_Remain : XString; 57 | Write_Remain : XString; 58 | end record; 59 | 60 | end Test_Streams; 61 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/coders/reset/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD Reset 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/coders/set_parameter/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD Set_Parameter 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/coders/transcode/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD Transcode API 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/file/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD version API 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/threading/test.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Test_Assert; 25 | with Test_Measure; 26 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 27 | with GNATCOLL.ZSTD; 28 | with GNATCOLL.ZSTD.Controlled; 29 | with GNATCOLL.OS.FS; 30 | 31 | function Test return Integer is 32 | 33 | package A renames Test_Assert; 34 | package M renames Test_Measure; 35 | package Z renames GNATCOLL.ZSTD.Controlled; 36 | package FS renames GNATCOLL.OS.FS; 37 | 38 | Uncompressed : Unbounded_String; 39 | In_Ctx : Z.ZSTD_Compress_Context; 40 | Out_Ctx : Z.ZSTD_Decompress_Context; 41 | FD, Src_FD, Dst_FD : FS.File_Descriptor; 42 | begin 43 | -- Create a test file 44 | FD := FS.Open ("./test.data", Mode => FS.Write_Mode); 45 | 46 | for Idx in 1 .. 10_000_000 loop 47 | FS.Write (FD, "0123456789"); 48 | end loop; 49 | FS.Close (FD); 50 | 51 | Src_FD := FS.Open ("./test.data"); 52 | Dst_FD := FS.Open ("./test.data.compressed", Mode => FS.Write_Mode); 53 | 54 | In_Ctx.Set_Parameter (GNATCOLL.ZSTD.ZSTD_C_Nb_Workers, 6); 55 | In_Ctx.Set_Parameter (GNATCOLL.ZSTD.ZSTD_C_Compression_Level, 9); 56 | M.Start_Measure; 57 | In_Ctx.Compress (Src_FD, Dst_FD); 58 | M.End_Measure (Message => "100MB compression time (file in and out)"); 59 | 60 | FS.Close (Src_FD); 61 | FS.Close (Dst_FD); 62 | 63 | Src_FD := FS.Open ("./test.data.compressed"); 64 | Uncompressed := Out_Ctx.Decompress (Src_FD); 65 | A.Assert (Length (Uncompressed) = 100 * 1_000_000); 66 | 67 | return A.Report; 68 | end Test; 69 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/threading/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD version API 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/unbounded_string/test.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Test_Assert; 25 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 26 | with GNATCOLL.ZSTD; 27 | with GNATCOLL.ZSTD.Controlled; 28 | with GNAT.IO; 29 | 30 | function Test return Integer is 31 | 32 | package A renames Test_Assert; 33 | package Z renames GNATCOLL.ZSTD.Controlled; 34 | package IO renames GNAT.IO; 35 | 36 | Input : Unbounded_String; 37 | Compressed : Unbounded_String; 38 | Uncompressed : Unbounded_String; 39 | In_Ctx : Z.ZSTD_Compress_Context; 40 | Out_Ctx : Z.ZSTD_Decompress_Context; 41 | begin 42 | Append (Input, "0123"); 43 | for Idx in 1 .. 100 loop 44 | Compressed := In_Ctx.Compress (Input); 45 | A.Assert (Length (Compressed) > 0); 46 | 47 | Uncompressed := Out_Ctx.Decompress (Compressed); 48 | A.Assert (Uncompressed = Input); 49 | end loop; 50 | 51 | for Idx in 1 .. 100 loop 52 | Uncompressed := Out_Ctx.Decompress (Compressed); 53 | A.Assert (Uncompressed = Input); 54 | end loop; 55 | 56 | Append (Input, "0123456789"); 57 | Compressed := In_Ctx.Compress (Input); 58 | IO.Put_Line (Length (Compressed)'Img); 59 | A.Assert (Length (Compressed) > 0); 60 | Uncompressed := Out_Ctx.Decompress (Compressed); 61 | A.Assert (Uncompressed = Input); 62 | return A.Report; 63 | end Test; 64 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/unbounded_string/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD version API 2 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/version/test.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- G N A T C O L L -- 3 | -- -- 4 | -- Copyright (C) 2024, AdaCore -- 5 | -- -- 6 | -- This library is free software; you can redistribute it and/or modify it -- 7 | -- under terms of the GNU General Public License as published by the Free -- 8 | -- Software Foundation; either version 3, or (at your option) any later -- 9 | -- version. This library is distributed in the hope that it will be useful, -- 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12 | -- -- 13 | -- As a special exception under Section 7 of GPL version 3, you are granted -- 14 | -- additional permissions described in the GCC Runtime Library Exception, -- 15 | -- version 3.1, as published by the Free Software Foundation. -- 16 | -- -- 17 | -- You should have received a copy of the GNU General Public License and -- 18 | -- a copy of the GCC Runtime Library Exception along with this program; -- 19 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20 | -- . -- 21 | -- -- 22 | ------------------------------------------------------------------------------ 23 | 24 | with Test_Assert; 25 | with GNATCOLL.ZSTD; 26 | with GNAT.IO; 27 | with Interfaces.C; 28 | 29 | function Test return Integer is 30 | 31 | package A renames Test_Assert; 32 | package C renames Interfaces.C; 33 | package Z renames GNATCOLL.ZSTD; 34 | package IO renames GNAT.IO; 35 | use all type C.unsigned; 36 | 37 | begin 38 | 39 | declare 40 | Version_Int : constant C.unsigned := Z.ZSTD_Version_Number; 41 | Version_Str : constant String := Z.ZSTD_Version_String; 42 | begin 43 | IO.Put_Line (Version_Str); 44 | A.Assert (Version_Str'Length > 0); 45 | A.Assert (Version_Str'Length > 0 and then 46 | Version_Str (Version_Str'Last) /= ASCII.NUL); 47 | IO.Put_Line (Version_Int'Img); 48 | A.Assert (Version_Int > 1 * 100 * 100 + 4 * 100); 49 | end; 50 | 51 | return A.Report; 52 | end Test; 53 | -------------------------------------------------------------------------------- /zstd/testsuite/tests/version/test.yaml: -------------------------------------------------------------------------------- 1 | title: GNATCOLL.ZSTD version API 2 | --------------------------------------------------------------------------------