diff options
author | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-09 16:58:40 +0100 |
---|---|---|
committer | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-09 16:58:40 +0100 |
commit | 70fe0035c03314d654846c40c807578b205df0c7 (patch) | |
tree | e3a092f2f0470aa216f2c1d1b854c233235f37b6 | |
parent | beb9098be01a7a048fa03860afbee62895d31f5b (diff) | |
parent | 0b86943aca51175968e40bbb6f2662dfe3fbfe59 (diff) | |
download | gcc-70fe0035c03314d654846c40c807578b205df0c7.zip gcc-70fe0035c03314d654846c40c807578b205df0c7.tar.gz gcc-70fe0035c03314d654846c40c807578b205df0c7.tar.bz2 |
Merge branch 'master' into devel/modula-2.
202 files changed, 3502 insertions, 3127 deletions
diff --git a/MAINTAINERS b/MAINTAINERS index 8770894..9aab238 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -360,7 +360,7 @@ Gabriel Charette <gchare@google.com> Chandra Chavva <cchavva@redhat.com> Dehao Chen <dehao@google.com> Fabien Chêne <fabien@gcc.gnu.org> -Clément Chigot <clement.chigot@atos.net> +Clément Chigot <chigot@adacore.com> Harshit Chopra <harshit@google.com> Tamar Christina <tamar.christina@arm.com> Eric Christopher <echristo@gmail.com> @@ -681,7 +681,7 @@ Przemyslaw Wirkus <przemyslaw.wirkus@arm.com> Carlo Wood <carlo@alinoe.com> Jackson Woodruff <jackson.woodruff@arm.com> Jonathan Wright <jonathan.wright@arm.com> -Ruoyao Xi <xry111@mengyan1223.wang> +Ruoyao Xi <xry111@xry111.site> Mingjie Xing <mingjie.xing@gmail.com> Chenghua Xu <paul.hua.gm@gmail.com> Canqun Yang <canqun@nudt.edu.cn> diff --git a/contrib/ChangeLog b/contrib/ChangeLog index cfacc18..9f9b011 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2022-05-06 Jakub Jelinek <jakub@redhat.com> + + * gennews (files): Add files for GCC 12. + 2022-04-28 Jakub Jelinek <jakub@redhat.com> * gcc-changelog/git_update_version.py (active_refs): Add diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 99ef848..7ebc075 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,38 @@ +2022-05-07 Marek Polacek <polacek@redhat.com> + + PR c++/101833 + PR c++/47634 + * tree-core.h (struct attribute_spec): Update comment for HANDLER. + +2022-05-06 Jason Merrill <jason@redhat.com> + + * diagnostic-color.cc: Add fnname and targs color entries. + * doc/invoke.texi: Document them. + +2022-05-06 Jason Merrill <jason@redhat.com> + + * vec.h (vec::iterate): Fix comment. + +2022-05-06 Michael Meissner <meissner@linux.ibm.com> + + PR target/102059 + * config/rs6000/rs6000.cc (rs6000_can_inline_p): Ignore -mpower8-fusion + and -mpower10-fusion options for inlining purposes. + +2022-05-06 Christophe Lyon <christophe.lyon@arm.com> + + * config/aarch64/iterators.md (GPF_TF_F16): Delete. + +2022-05-06 Marcel Vollweiler <marcel@codesourcery.com> + + * omp-low.cc (omp_runtime_api_call): Added target_is_accessible to + omp_runtime_apis array. + +2022-05-06 Hafiz Abid Qadeer <abidh@codesourcery.com> + + * omp-low.cc (omp_maybe_offloaded_ctx): New prototype. + (scan_sharing_clauses): Check a restriction on allocate clause. + 2022-05-05 Sandra Loosemore <sandra@codesourcery.com> * gimplify.cc (gimplify_omp_for): Update messages for SCHEDULED diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 5047833..6baccb8 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20220506 +20220509 diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 591d033..2ae4ded 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -3556,7 +3556,7 @@ __gnat_get_executable_load_address (void) } void -__gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED) +__gnat_kill (int pid, int sig) { #if defined(_WIN32) HANDLE h; @@ -3595,7 +3595,7 @@ void __gnat_killprocesstree (int pid, int sig_num) if (hSnap == INVALID_HANDLE_VALUE) { - __gnat_kill (pid, sig_num, 1); + __gnat_kill (pid, sig_num); return; } @@ -3618,7 +3618,7 @@ void __gnat_killprocesstree (int pid, int sig_num) /* kill process */ - __gnat_kill (pid, sig_num, 1); + __gnat_kill (pid, sig_num); #elif defined (__vxworks) /* not implemented */ @@ -3635,7 +3635,7 @@ void __gnat_killprocesstree (int pid, int sig_num) if (!dir) { - __gnat_kill (pid, sig_num, 1); + __gnat_kill (pid, sig_num); return; } @@ -3673,9 +3673,9 @@ void __gnat_killprocesstree (int pid, int sig_num) /* kill process */ - __gnat_kill (pid, sig_num, 1); + __gnat_kill (pid, sig_num); #else - __gnat_kill (pid, sig_num, 1); + __gnat_kill (pid, sig_num); #endif /* Note on Solaris it is possible to read /proc/<PID>/status. The 5th and 6th words are the pid and the 7th and 8th the ppid. diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index eec9dd5..d7ba267 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -2907,7 +2907,7 @@ package body Bindgen is Nlen := Name'Length; Name (Name'Last) := Character'Val (J mod 10 + Character'Pos ('0')); Name (Name'Last - 1) := - Character'Val (J / 10 + Character'Pos ('0')); + Character'Val (J / 10 + Character'Pos ('0')); end if; for K in ALIs.First .. ALIs.Last loop diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index fbd60eb..25bfbc7 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -90,11 +90,11 @@ Syntax: | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY} ) EXTERNAL_PROPERTY ::= - Async_Readers [=> boolean_EXPRESSION] - | Async_Writers [=> boolean_EXPRESSION] - | Effective_Reads [=> boolean_EXPRESSION] - | Effective_Writes [=> boolean_EXPRESSION] - others => boolean_EXPRESSION + Async_Readers [=> static_boolean_EXPRESSION] + | Async_Writers [=> static_boolean_EXPRESSION] + | Effective_Reads [=> static_boolean_EXPRESSION] + | Effective_Writes [=> static_boolean_EXPRESSION] + others => static_boolean_EXPRESSION STATE_NAME ::= defining_identifier @@ -600,7 +600,7 @@ Syntax: .. code-block:: ada - pragma Async_Readers [ (boolean_EXPRESSION) ]; + pragma Async_Readers [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Async_Readers`` in the SPARK 2014 Reference Manual, section 7.1.2. @@ -614,7 +614,7 @@ Syntax: .. code-block:: ada - pragma Async_Writers [ (boolean_EXPRESSION) ]; + pragma Async_Writers [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Async_Writers`` in the SPARK 2014 Reference Manual, section 7.1.2. @@ -1132,7 +1132,7 @@ Syntax: .. code-block:: ada - pragma Constant_After_Elaboration [ (boolean_EXPRESSION) ]; + pragma Constant_After_Elaboration [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Constant_After_Elaboration`` in the SPARK 2014 Reference Manual, section 3.3.1. @@ -1656,7 +1656,7 @@ Syntax: .. code-block:: ada - pragma Effective_Reads [ (boolean_EXPRESSION) ]; + pragma Effective_Reads [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Effective_Reads`` in the SPARK 2014 Reference Manual, section 7.1.2. @@ -1670,7 +1670,7 @@ Syntax: .. code-block:: ada - pragma Effective_Writes [ (boolean_EXPRESSION) ]; + pragma Effective_Writes [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Effective_Writes`` in the SPARK 2014 Reference Manual, section 7.1.2. @@ -2401,7 +2401,7 @@ Syntax: .. code-block:: ada - pragma Extensions_Visible [ (boolean_EXPRESSION) ]; + pragma Extensions_Visible [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Extensions_Visible`` in the SPARK 2014 Reference Manual, section 6.1.7. @@ -2615,7 +2615,7 @@ Syntax: .. code-block:: ada - pragma Ghost [ (boolean_EXPRESSION) ]; + pragma Ghost [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Ghost`` in the SPARK 2014 Reference Manual, section 6.9. @@ -3969,7 +3969,7 @@ Syntax: .. code-block:: ada - pragma No_Caching [ (boolean_EXPRESSION) ]; + pragma No_Caching [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``No_Caching`` in the SPARK 2014 Reference Manual, section 7.1.2. @@ -7313,7 +7313,7 @@ For the variable case, warnings are never given for unreferenced variables whose name contains one of the substrings ``DISCARD, DUMMY, IGNORE, JUNK, UNUSED`` in any casing. Such names are typically to be used in cases where such warnings are expected. -Thus it is never necessary to use ``pragma Unmodified`` for such +Thus it is never necessary to use ``pragma Unused`` for such variables, though it is harmless to do so. Pragma Validity_Checks @@ -7430,7 +7430,7 @@ Syntax: .. code-block:: ada - pragma Volatile_Function [ (boolean_EXPRESSION) ]; + pragma Volatile_Function [ (static_boolean_EXPRESSION) ]; For the semantics of this pragma, see the entry for aspect ``Volatile_Function`` in the SPARK 2014 Reference Manual, section 7.1.2. diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst index d030cd4..def11a6 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst @@ -18,7 +18,6 @@ This chapter describes a number of utility programs: * :ref:`The_GNAT_Metrics_Tool_gnatmetric` * :ref:`The_GNAT_Pretty_Printer_gnatpp` * :ref:`The_Body_Stub_Generator_gnatstub` - * :ref:`The_Unit_Test_Generator_gnattest` * :ref:`The_Backtrace_Symbolizer_gnatsymbolize` It also describes how several of these tools can be used in conjunction @@ -3266,922 +3265,6 @@ building specialized scripts. .. only:: PRO or GPL - .. _The_Unit_Test_Generator_gnattest: - - The Unit Test Generator ``gnattest`` - ==================================== - - .. index:: ! gnattest - - ``gnattest`` is an ASIS-based utility that creates unit-test skeletons - as well as a test driver infrastructure (harness). ``gnattest`` creates - a skeleton for each visible subprogram in the packages under consideration when - they do not exist already. - - ``gnattest`` is a project-aware tool. - (See :ref:`Using_Project_Files_with_GNAT_Tools` for a description of - the project-related switches but note that ``gnattest`` does not support - the :switch:`-U`, :switch:`-eL`, :switch:`--subdirs={dir}`, or - :switch:`--no-objects-dir` switches.) - The project file package that can specify - ``gnattest`` switches is named ``gnattest``. - - The user can choose to generate a single test driver - that will run all individual tests, or separate test drivers for each test. The - second option allows much greater flexibility in test execution environment, - allows to benefit from parallel tests execution to increase performance, and - provides stubbing support. - - ``gnattest`` also has a mode of operation where it acts as the test - aggregator when multiple test executables must be run, in particular when - the separate test drivers were generated. In this mode it handles individual - tests execution and upon completion reports the summary results of the test - run. - - In order to process source files from a project, ``gnattest`` has to - semantically analyze the sources. Therefore, test skeletons can only be - generated for legal Ada units. If a unit is dependent on other units, - those units should be among the source files of the project or of other projects - imported by this one. - - Generated skeletons and harnesses are based on the AUnit testing framework. - AUnit is an Ada adaptation of the xxxUnit testing frameworks, similar to JUnit - for Java or CppUnit for C++. While it is advised that gnattest users read - the AUnit manual, deep knowledge of AUnit is not necessary for using ``gnattest``. - For correct operation of ``gnattest``, AUnit should be installed and - aunit.gpr must be on the project path. Except for some special circumstances - (e.g. a custom run-time is used), this should normally be the case out of the box. - - - .. _Running_gnattest: - - Running ``gnattest`` - -------------------- - - There are two ways of running ``gnattest``. - - .. _Framework_Generation_Mode: - - Framework Generation Mode - ^^^^^^^^^^^^^^^^^^^^^^^^^ - - In this mode ``gnattest`` has the following command-line interface: - - :: - - $ gnattest -Pprojname [ switches ] [ filename ] [ -cargs gcc_switches ] - - where - - * :switch:`-P{projname}` - specifies the project defining the location of source files. When no - file names are provided on the command line, all sources in the project - are used as input. This switch is required. - - * :switch:`{filename}` - is the name of the source file containing the library unit package *declaration* - (the package "spec") for which a test package will be created. The file name - may be given with a path. - - * :samp:`{switches}` - is an optional sequence of switches as described below. - - * :samp:`{gcc_switches}` - is a list of additional switches for - ``gcc`` that will be passed to all compiler invocations - made by ``gnattest`` to generate a set of ASIS trees. - - - ``gnattest`` results can be found in two different places. - - * *automatic harness*: - This is the harness code, which is located by default in - "gnattest/harness" directory created in the object directory of - the main project file. All of this code is generated completely - automatically and can be destroyed and regenerated at will, with the - exception of the file *gnattest_common.gpr*, which is created if absent, - but never overwritten. It is not recommended to modify other files - manually, since these modifications will be lost if ``gnattest`` is re-run. - The entry point in the harness code is - the project file named *test_driver.gpr*. Tests can be compiled and run - using a command such as: - - :: - - $ gprbuild -P<harness-dir>/test_driver - - Note that if you need to adjust any options used to compile the harness, - you can do so by editing the file *gnattest_common.gpr*. - - * *actual unit test skeletons*: - A test skeleton for each visible subprogram is created in a separate file, if it - doesn't exist already. By default, those separate test files are located in a - "gnattest/tests" directory that is created in the object directory of - corresponding project file. For example, if a source file my_unit.ads in - directory src contains a visible subprogram Proc, then the corresponding unit - test will be found in file src/tests/my_unit-test_data-tests.adb and will be - called Test_Proc_<code>. <code> is a signature encoding used to differentiate - test names in case of overloading. - - Note that if the project already has both my_unit.ads and my_unit-test_data.ads, - this will cause a name conflict with the generated test package. - - - .. _Test_Execution_Mode: - - Test Execution Mode - ^^^^^^^^^^^^^^^^^^^ - - In this mode ``gnattest`` has a the following command-line interface: - - :: - - $ gnattest test_drivers.list [ switches ] - - where - - * :samp:`{test_drivers.list}` - is the name of the text file containing the list of executables to treat as - test drivers. This file is automatically generated by gnattest, but can be - hand-edited to add or remove tests. This switch is required. - - - * :samp:`{switches}` - is an optional sequence of switches as described below. - - - .. _Switches_for_gnattest_in_framework_generation_mode: - - Switches for ``gnattest`` in framework generation mode - ------------------------------------------------------ - - .. index:: --strict (gnattest) - - :switch:`--strict` - Return error exit code if there are any compilation errors. - - .. index:: -q (gnattest) - - :switch:`-q` - Quiet mode: suppresses noncritical output messages. - - - .. index:: -v (gnattest) - - :switch:`-v` - Verbose mode: produces additional output about the execution of the tool. - When specified alone on the command line, prints tool version and exits. - - - .. index:: -r (gnattest) - - :switch:`-r` - Recursively considers all sources from all projects. - - .. index:: -files (gnattest) - - :switch:`-files={filename}` - Take as arguments the files listed in text file ``file``. - Text file ``file`` may contain empty lines that are ignored. - Each nonempty line should contain the name of an existing file. - Several such switches may be specified simultaneously. - - .. index:: --ignore (gnattest) - - :switch:`--ignore={filename}` - Do not process the sources listed in a specified file. - - .. index:: --RTS (gnattest) - - :switch:`--RTS={rts-path}` - Specifies the default location of the runtime library. Same meaning as the - equivalent ``gnatmake`` flag (:ref:`Switches_for_gnatmake`). For restricted - profiles, ``gnattest`` takes into account the run-time limitations when - generating the harness. - - - .. index:: --additional-tests (gnattest) - - :switch:`--additional-tests={projname}` - Sources described in ``projname`` are considered potential additional - manual tests to be added to the test suite. - - - .. index:: --harness-only (gnattest) - - :switch:`--harness-only` - When this option is given, ``gnattest`` creates a harness for all - sources, treating them as test packages. This option is not compatible with - closure computation done by -U main. - - - .. index:: --separate-drivers (gnattest) - - :switch:`--separate-drivers[={val}]` - Generates a separate test driver for each test or unit under test, rather - than a single executable incorporating all tests. ``val`` can be "unit" or - "test", or may be omitted, which defaults to "unit". - - - .. index:: --stub (gnattest) - - :switch:`--stub` - Generates the testing framework that uses subsystem stubbing to isolate the - code under test. - - - .. index:: --harness-dir (gnattest) - - :switch:`--harness-dir={dirname}` - Specifies the directory that will hold the harness packages and project file - for the test driver. If the ``dirname`` is a relative path, it is considered - relative to the object directory of the project file. - - - .. index:: --tests-dir (gnattest) - - :switch:`--tests-dir={dirname}` - All test packages are placed in the ``dirname`` directory. - If the ``dirname`` is a relative path, it is considered relative to the object - directory of the project file. When all sources from all projects are taken - recursively from all projects, ``dirname`` directories are created for each - project in their object directories and test packages are placed accordingly. - - - .. index:: --subdir (gnattest) - - :switch:`--subdir={dirname}` - Test packages are placed in a subdirectory of the corresponding source - directory, with the name ``dirname``. Thus, each set of unit tests is located - in a subdirectory of the code under test. If the sources are in separate - directories, each source directory has a test subdirectory named ``dirname``. - - - .. index:: --tests-root (gnattest) - - :switch:`--tests-root={dirname}` - The hierarchy of source directories, if any, is recreated in the ``dirname`` - directory, with test packages placed in directories corresponding to those - of the sources. - If the ``dirname`` is a relative path, it is considered relative to the object - directory of the project file. When projects are considered recursively, - directory hierarchies of tested sources are - recreated for each project in their object directories and test packages are - placed accordingly. - - - .. index:: --stubs-dir (gnattest) - - :switch:`--stubs-dir={dirname}` - The hierarchy of directories containing stubbed units is recreated in - the ``dirname`` directory, with stubs placed in directories corresponding to - projects they are derived from. - If the ``dirname`` is a relative path, it is considered relative to the object - directory of the project file. When projects are considered recursively, - directory hierarchies of stubs are - recreated for each project in their object directories and test packages are - placed accordingly. - - - .. index:: --exclude-from-stubbing (gnattest) - - :switch:`--exclude-from-stubbing={filename}` - Disables stubbing of units listed in ``filename``. The file should contain - corresponding spec files, one per line. - - :switch:`--exclude-from-stubbing:{unit}={filename}` - Same as above, but corresponding units will not be stubbed only when testing - specified ``unit``. - - .. index:: --validate-type-extensions (gnattest) - - :switch:`--validate-type-extensions` - Enables substitution check: run all tests from all parents in order - to check substitutability in accordance with the Liskov substitution principle (LSP). - - .. index:: --inheritance-check (gnattest) - - :switch:`--inheritance-check` - Enables inheritance check: run inherited tests against descendants. - - .. index:: --no-inheritance-check (gnattest) - - :switch:`--no-inheritance-check` - Disables inheritance check. - - .. index:: --no-inheritance-check (gnattest) - - :switch:`--test-case-only` - Generates test skeletons only for subprograms that have at least one - associated pragma or aspect Test_Case. - - .. index:: --skeleton-default (gnattest) - - :switch:`--skeleton-default={val}` - Specifies the default behavior of generated skeletons. ``val`` can be either - "fail" or "pass", "fail" being the default. - - - .. index:: --passed-tests (gnattest) - - :switch:`--passed-tests={val}` - Specifies whether or not passed tests should be shown. ``val`` can be either - "show" or "hide", "show" being the default. - - - .. index:: --exit-status (gnattest) - - :switch:`--exit-status={val}` - Specifies whether or not generated test driver should return failure exit - status if at least one test fails or crashes. ``val`` can be either - "on" or "off", "off" being the default. - - - .. index:: --omit-sloc (gnattest) - - :switch:`--omit-sloc` - Suppresses comment line containing file name and line number of corresponding - subprograms in test skeletons. - - - .. index:: --no-command-line (gnattest) - - :switch:`--no-command-line` - Don't add command line support to test driver. Note that regardless of this - switch, ``gnattest`` will automatically refrain from adding command - line support if it detects that the selected run-time doesn't provide - this capability. - - - .. index:: --separates (gnattest) - - :switch:`--separates` - Bodies of all test routines are generated as separates. Note that this mode is - kept for compatibility reasons only and it is not advised to use it due to - possible problems with hash in names of test skeletons when using an - inconsistent casing. Separate test skeletons can be incorporated to monolith - test package with improved hash being used by using ``--transition`` - switch. - - - .. index:: --transition (gnattest) - - :switch:`--transition` - This allows transition from separate test routines to monolith test packages. - All matching test routines are overwritten with contents of corresponding - separates. Note that if separate test routines had any manually added with - clauses they will be moved to the test package body as is and have to be moved - by hand. - - - .. index:: --test-duration (gnattest) - - :switch:`--test-duration` - Adds time measurements for each test in generated test driver. - - - :switch:`--tests_root`, :switch:`--subdir` and :switch:`--tests-dir` switches are mutually exclusive. - - - .. _Switches_for_gnattest_in_test_execution_mode: - - Switches for ``gnattest`` in test execution mode - ------------------------------------------------ - - - .. index:: --passed-tests (gnattest) - - :switch:`--passed-tests={val}` - Specifies whether or not passed tests should be shown. ``val`` can be either - "show" or "hide", "show" being the default. - - - .. index:: --queues (gnattest) - .. index:: -j (gnattest) - - :switch:`--queues={n}`, :switch:`-j{n}` - Runs ``n`` tests in parallel (default is 1). - - - .. index:: --copy-environment (gnattest) - - :switch:`--copy-environment={dir}` - Contents of ``dir`` directory will be copied to temporary directories - created by gnattest in which individual test drivers are spawned. - - - .. _Project_Attributes_for_gnattest: - - Project Attributes for ``gnattest`` - ----------------------------------- - - Most of the command-line options can also be passed to the tool by adding - special attributes to the project file. Those attributes should be put in - package ``Gnattest``. Here is the list of attributes: - - - * ``Tests_Root`` - is used to select the same output mode as with the ``--tests-root`` option. - This attribute cannot be used together with ``Subdir`` or ``Tests_Dir``. - - * ``Subdir`` - is used to select the same output mode as with the ``--subdir`` option. - This attribute cannot be used together with ``Tests_Root`` or ``Tests_Dir``. - - * ``Tests_Dir`` - is used to select the same output mode as with the ``--tests-dir`` option. - This attribute cannot be used together with ``Subdir`` or ``Tests_Root``. - - * ``Stubs_Dir`` - is used to select the same output mode as with the ``--stubs-dir`` option. - - * ``Harness_Dir`` - is used to specify the directory in which to place harness packages and project - file for the test driver, otherwise specified by ``--harness-dir``. - - * ``Additional_Tests`` - is used to specify the project file, otherwise given by - ``--additional-tests`` switch. - - * ``Skeletons_Default`` - is used to specify the default behaviour of test skeletons, otherwise - specified by ``--skeleton-default`` option. The value of this attribute - should be either ``pass`` or ``fail``. - - * ``Default_Stub_Exclusion_List`` - is used to specify the file with list of units whose bodies should not - be stubbed, otherwise specified by ``--exclude-from-stubbing=filename``. - - * ``Stub_Exclusion_List ("unit")`` - is used to specify the file with list of units whose bodies should not - be stubbed when testing "unit", otherwise specified by - ``--exclude-from-stubbing:unit=filename``. - - Each of those attributes can be overridden from the command line if needed. - Other ``gnattest`` switches can also be passed via the project - file as an attribute list called ``Gnattest_Switches``. - - - .. _Simple_gnattest_Example: - - Simple Example - -------------- - - Let's take a very simple example using the first ``gnattest`` example - located in: - - :: - - <install_prefix>/share/examples/gnattest/simple - - This project contains a simple package containing one subprogram. By running ``gnattest``: - - :: - - $ gnattest --harness-dir=driver -Psimple.gpr - - a test driver is created in directory ``driver``. It can be compiled and run: - - :: - - $ cd obj/driver - $ gprbuild -Ptest_driver - $ test_runner - - One failed test with the diagnosis "test not implemented" is reported. - Since no special output option was specified, the test package ``Simple.Tests`` - is located in: - - :: - - <install_prefix>/share/examples/gnattest/simple/obj/gnattest/tests - - - For each package containing visible subprograms, a child test package is - generated. It contains one test routine per tested subprogram. Each - declaration of a test subprogram has a comment specifying which tested - subprogram it corresponds to. Bodies of test routines are placed in test package - bodies and are surrounded by special comment sections. Those comment sections - should not be removed or modified in order for gnattest to be able to regenerate - test packages and keep already written tests in place. - The test routine ``Test_Inc_5eaee3`` located at :file:`simple-test_data-tests.adb` contains - a single statement: a call to procedure ``Assert``. It has two arguments: - the Boolean expression we want to check and the diagnosis message to display if - the condition is false. - - That is where actual testing code should be written after a proper setup. - An actual check can be performed by replacing the ``Assert`` call with: - - :: - - Assert (Inc (1) = 2, "wrong incrementation"); - - After recompiling and running the test driver, one successfully passed test - is reported. - - - .. _Setting_Up_and_Tearing_Down_the_Testing_Environment: - - Setting Up and Tearing Down the Testing Environment - --------------------------------------------------- - - Besides test routines themselves, each test package has a parent package - ``Test_Data`` that has two procedures: ``Set_Up`` and ``Tear_Down``. This package is never - overwritten by the tool. ``Set_Up`` is called before each test routine of the - package, and ``Tear_Down`` is called after each test routine. Those two procedures - can be used to perform necessary initialization and finalization, - memory allocation, etc. Test type declared in ``Test_Data`` package is parent type - for the test type of test package and can have user-defined components whose - values can be set by ``Set_Up`` routine and used in test routines afterwards. - - - .. _Regenerating_Tests: - - Regenerating Tests - ------------------ - - Bodies of test routines and ``Test_Data`` packages are never overridden after they - have been created once. As long as the name of the subprogram, full expanded Ada - names and order of its parameters are the same, and comment sections are - intact, the old test routine will fit in its place and no test skeleton will be - generated for the subprogram. - - This can be demonstrated with the previous example. By uncommenting declaration - and body of function Dec in ``simple.ads`` and ``simple.adb``, running - ``gnattest`` on the project, and then running the test driver: - - :: - - $ gnattest --harness-dir=driver -Psimple.gpr - $ cd obj/driver - $ gprbuild -Ptest_driver - $ test_runner - - The old test is not replaced with a stub, nor is it lost, but a new test - skeleton is created for function ``Dec``. - - The only way of regenerating tests skeletons is to remove the previously created - tests together with corresponding comment sections. - - - .. _Default_Test_Behavior: - - Default Test Behavior - --------------------- - - The generated test driver can treat unimplemented tests in two ways: - either count them all as failed (this is useful to see which tests are still - left to implement) or as passed (to sort out unimplemented ones from those - actually failing). - - The test driver accepts a switch to specify this behavior: - :switch:`--skeleton-default={val}`, where ``val`` is either ``pass`` or ``fail`` (exactly as for - ``gnattest``). - - The default behavior of the test driver is set with the same switch - as passed to ``gnattest`` when generating the test driver. - - Passing it to the driver generated on the first example: - - :: - - $ test_runner --skeleton-default=pass - - makes both tests pass, even the unimplemented one. - - - .. _Testing_Primitive_Operations_of_Tagged_Types: - - Testing Primitive Operations of Tagged Types - -------------------------------------------- - - Creation of test skeletons for primitive operations of tagged types entails - a number of features. Test routines for all primitives of a given tagged type - are placed in a separate child package named according to the tagged type. For - example, if you have tagged type ``T`` in package ``P``, all tests for primitives - of ``T`` will be in ``P.T_Test_Data.T_Tests``. - - Consider running ``gnattest`` on the second example (note: actual tests for this - example already exist, so there's no need to worry if the tool reports that - no new stubs were generated): - - :: - - $ cd <install_prefix>/share/examples/gnattest/tagged_rec - $ gnattest --harness-dir=driver -Ptagged_rec.gpr - - Taking a closer look at the test type declared in the test package - *Speed1.Controller_Test_Data* is necessary. It is declared in: - - :: - - <install_prefix>/share/examples/gnattest/tagged_rec/obj/gnattest/tests - - Test types are direct or indirect descendants of - *AUnit.Test_Fixtures.Test_Fixture* type. In the case of non-primitive tested - subprograms, the user doesn't need to be concerned with them. However, - when generating test packages for primitive operations, there are some things - the user needs to know. - - Type ``Test_Controller`` has components that allow assignment of various - derivations of type ``Controller``. And if you look at the specification of - package *Speed2.Auto_Controller*, you will see that ``Test_Auto_Controller`` - actually derives from ``Test_Controller`` rather than AUnit type ``Test_Fixture``. - Thus, test types mirror the hierarchy of tested types. - - The ``Set_Up`` procedure of ``Test_Data`` package corresponding to a test package - of primitive operations of type ``T`` assigns to ``Fixture`` a reference to an - object of that exact type ``T``. Note, however, that if the tagged type has - discriminants, the ``Set_Up`` only has a commented template for setting - up the fixture, since filling the discriminant with actual value is up - to the user. - - The knowledge of the structure of test types allows additional testing - without additional effort. Those possibilities are described below. - - - .. _Testing_Inheritance: - - Testing Inheritance - ------------------- - - Since the test type hierarchy mimics the hierarchy of tested types, the - inheritance of tests takes place. An example of such inheritance can be - seen by running the test driver generated for the second example. As previously - mentioned, actual tests are already written for this example. - - :: - - $ cd obj/driver - $ gprbuild -Ptest_driver - $ test_runner - - There are 6 passed tests while there are only 5 testable subprograms. The test - routine for function Speed has been inherited and run against objects of the - derived type. - - - .. _Tagged_Type_Substitutability_Testing: - - Tagged Type Substitutability Testing - ------------------------------------ - - *Tagged Type Substitutability Testing* is a way of verifying the global type - consistency by testing. Global type consistency is a principle stating that if - ``S`` is a subtype of ``T`` (in Ada, ``S`` is a derived type of tagged type ``T``), - then objects of type ``T`` may be replaced with objects of type ``S`` (that is, - objects of type ``S`` may be substituted for objects of type ``T``), without - altering any of the desirable properties of the program. When the properties - of the program are expressed in the form of subprogram preconditions and - postconditions (let's call them pre and post), the principle is formulated as - relations between the pre and post of primitive operations and the pre and post - of their derived operations. The pre of a derived operation should not be - stronger than the original pre, and the post of the derived operation should - not be weaker than the original post. Those relations ensure that verifying if - a dispatching call is safe can be done just by using the pre and post of the - root operation. - - Verifying global type consistency by testing consists of running all the unit - tests associated with the primitives of a given tagged type with objects of its - derived types. - - In the example used in the previous section, there was clearly a violation of - type consistency. The overriding primitive ``Adjust_Speed`` in package ``Speed2`` - removes the functionality of the overridden primitive and thus doesn't respect - the consistency principle. - ``gnattest`` has a special option to run overridden parent tests against objects - of the type which have overriding primitives: - - :: - - $ gnattest --harness-dir=driver --validate-type-extensions -Ptagged_rec.gpr - $ cd obj/driver - $ gprbuild -Ptest_driver - $ test_runner - - While all the tests pass by themselves, the parent test for ``Adjust_Speed`` fails - against objects of the derived type. - - Non-overridden tests are already inherited for derived test types, so the - ``--validate-type-extensions`` enables the application of overridden tests - to objects of derived types. - - - .. _Testing_with_Contracts: - - Testing with Contracts - ---------------------- - - ``gnattest`` supports pragmas ``Pre``, ``Post``, and ``Test_Case``, - as well as the corresponding Ada 2012 aspects. - Test routines are generated, one per each ``Test_Case`` associated with a tested - subprogram. Those test routines have special wrappers for tested functions - that have composition of pre- and postcondition of the subprogram with - "requires" and "ensures" of the ``Test_Case`` (depending on the mode, pre and post - either count for ``Nominal`` mode or do *not* count for ``Robustness`` mode). - - The third example demonstrates how this works: - - :: - - $ cd <install_prefix>/share/examples/gnattest/contracts - $ gnattest --harness-dir=driver -Pcontracts.gpr - - Putting actual checks within the range of the contract does not cause any - error reports. For example, for the test routine which corresponds to - test case 1: - - :: - - Assert (Sqrt (9.0) = 3.0, "wrong sqrt"); - - and for the test routine corresponding to test case 2: - - :: - - Assert (Sqrt (-5.0) = -1.0, "wrong error indication"); - - are acceptable: - - :: - - $ cd obj/driver - $ gprbuild -Ptest_driver - $ test_runner - - However, by changing 9.0 to 25.0 and 3.0 to 5.0, for example, you can get - a precondition violation for test case one. Also, by using any otherwise - correct but positive pair of numbers in the second test routine, you can also - get a precondition violation. Postconditions are checked and reported - the same way. - - - .. _Additional_Tests: - - Additional Tests - ---------------- - - ``gnattest`` can add user-written tests to the main suite of the test - driver. ``gnattest`` traverses the given packages and searches for test - routines. All procedures with a single in out parameter of a type which is - derived from *AUnit.Test_Fixtures.Test_Fixture* and that are declared in package - specifications are added to the suites and are then executed by the test driver. - (``Set_Up`` and ``Tear_Down`` are filtered out.) - - An example illustrates two ways of creating test harnesses for user-written - tests. Directory ``additional_tests`` contains an AUnit-based test driver written - by hand. - - :: - - <install_prefix>/share/examples/gnattest/additional_tests/ - - To create a test driver for already-written tests, use the ``--harness-only`` - option: - - :: - - gnattest -Padditional/harness/harness.gpr --harness-dir=harness_only \\ - --harness-only - gprbuild -Pharness_only/test_driver.gpr - harness_only/test_runner - - Additional tests can also be executed together with generated tests: - - :: - - gnattest -Psimple.gpr --additional-tests=additional/harness/harness.gpr \\ - --harness-dir=mixing - gprbuild -Pmixing/test_driver.gpr - mixing/test_runner - - - .. _Individual_Test_Drivers: - - Individual Test Drivers - ----------------------- - - By default, ``gnattest`` generates a monolithic test driver that - aggregates the individual tests into a single executable. It is also possible - to generate separate executables for each test or each unit under test, by - passing the switch ``--separate-drivers`` with corresponding parameter. This - approach scales better for large testing campaigns, especially involving target - architectures with limited resources typical for embedded development. It can - also provide a major performance benefit on multi-core systems by allowing - simultaneous execution of multiple tests. - - ``gnattest`` can take charge of executing the individual tests; for this, - instead of passing a project file, a text file containing the list of - executables can be passed. Such a file is automatically generated by gnattest - under the name :file:`test_drivers.list`, but it can be - hand-edited to add or remove tests, or replaced. The individual tests can - also be executed standalone, or from any user-defined scripted framework. - - - .. _Stubbing: - - Stubbing - -------- - - Depending on the testing campaign, it is sometimes necessary to isolate the - part of the algorithm under test from its dependencies. This is accomplished - via *stubbing*, i.e. replacing the subprograms that are called from the - subprogram under test by stand-in subprograms that match the profiles of the - original ones, but simply return predetermined values required by the test - scenario. - - This mode of test harness generation is activated by the switch ``--stub``. - - The implementation approach chosen by ``gnattest`` is as follows. - For each package under consideration all the packages it is directly depending - on are stubbed, excluding the generic packages and package instantiations. - The stubs are shared for each package under test. The specs of packages to stub - remain intact, while their bodies are replaced, and hide the original bodies by - means of extending projects. Also, for each stubbed - package, a child package with setter routines for each subprogram declaration - is created. These setters are meant to be used to set the behavior of - stubbed subprograms from within test cases. - - Note that subprograms belonging to the same package as the subprogram under - test are not stubbed. This guarantees that the sources being tested are - exactly the sources used for production, which is an important property for - establishing the traceability between the testing campaign and production code. - - Due to the nature of stubbing process, this mode implies the switch - ``--separate-drivers``, i.e. an individual test driver (with the - corresponding hierarchy of extending projects) is generated for each unit under - test. - - .. note:: - - Developing a stubs-based testing campaign requires - good understanding of the infrastructure created by ``gnattest`` for - this purpose. We recommend following the two stubbing tutorials - ``simple_stubbing`` and ``advanced_stubbing`` provided - under :file:`<install_prefix>/share/examples/gnattest` before - attempting to use this powerful feature. - - - .. _Gnatcov_Integration: - - Integration with GNATcoverage - ----------------------------- - - In addition to the harness, ``gnattest`` generates a Makefile. This Makefile - provides targets for building the test drivers and also the targets for - computing the coverage information using GNATcoverage framework when this - coverage analysis tool is available. The target ``coverage`` fully automates - the process: it will first build all test drivers, then run them under - GNATcoverage, analyze individual trace files, and finally aggregate them: - - :: - - make coverage - - GNATcoverage options, such as coverage criteria and generated report format, - can be adjusted using Makefile variables provided for this purpose. - - Note that coverage targets are not generated in the Makefile when - --separate-drivers=test is passed to gnattest. - - - .. _Putting_Tests_under_Version_Control: - - Putting Tests under Version Control - ----------------------------------- - - As has been stated earlier, ``gnattest`` generates two different types - of code, test skeletons and harness. The harness is generated completely - automatically each time, does not require manual changes and therefore should - not be put under version control. - It makes sense to put under version control files containing test data packages, - both specs and bodies, and files containing bodies of test packages. Note that - test package specs are also generated automatically each time and should not be - put under version control. - Option ``--omit-sloc`` may be useful when putting test packages under version control. - - - .. _Current_Limitations: - - Current Limitations - ------------------- - - The tool currently has the following limitations: - - * generic tests for nested generic packages and their instantiations are - not supported; - * tests for protected subprograms and entries are not supported; - * pragma ``No_Run_Time`` is not supported; - * pragma ``No_Secondary_Stack`` is not supported; - * if pragmas for interfacing with foreign languages are used, manual - adjustments might be necessary to make the test harness compilable; - * use of some constructs, such as elaboration-control pragmas, Type_Invariant - aspects, and complex variable initializations that use Subprogram'Access, - may result in elaboration circularities in the generated harness. - - -.. only:: PRO or GPL - .. _The_Backtrace_Symbolizer_gnatsymbolize: Translating Code Addresses into Source Locations with ``gnatsymbolize`` diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c709a1f..9fed73d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4846,23 +4846,29 @@ package Einfo is -- E_Access_Type, -- E_General_Access_Type, +-- E_Anonymous_Access_Type + -- E_Access_Subprogram_Type, -- E_Anonymous_Access_Subprogram_Type, + -- E_Access_Protected_Subprogram_Type, -- E_Anonymous_Access_Protected_Subprogram_Type --- E_Anonymous_Access_Type. --- E_Access_Subtype is for an access subtype created by a subtype --- declaration. +-- E_Access_Subtype is for an access subtype created by a subtype declaration -- In addition, we define the kind E_Allocator_Type to label allocators. -- This is because special resolution rules apply to this construct. -- Eventually the constructs are labeled with the access type imposed by -- the context. The backend should never see types with this Ekind. --- Similarly, the type E_Access_Attribute_Type is used as the initial kind --- associated with an access attribute. After resolution a specific access --- type will be established as determined by the context. +-- Similarly, we define the kind E_Access_Attribute_Type as the initial +-- kind associated with an access attribute whose prefix is an object. +-- After resolution, a specific access type will be established instead +-- as determined by the context. Note that, for the case of an access +-- attribute whose prefix is a subprogram, we build a corresponding type +-- with E_Access_Subprogram_Type or E_Access_Protected_Subprogram_Type kind +-- but whose designated type is the subprogram itself, instead of a regular +-- E_Subprogram_Type entity. -------------------------------------------------------- -- Description of Defined Attributes for Entity_Kinds -- diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 105f467..05329dc 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -100,6 +100,11 @@ package Err_Vars is -- -- Some of these are initialized below, because they are read before being -- set by clients. + -- + -- Would it be desirable to use arrays (with element renamings) here + -- instead of individual variables, at least for the Error_Msg_Name_N and + -- Error_Msg_Node_N ??? This would allow simplifying existing code in some + -- cases (see errout.adb). Error_Msg_Col : Column_Number; -- Column for @ insertion character in message @@ -116,6 +121,9 @@ package Err_Vars is Error_Msg_Name_1 : Name_Id; Error_Msg_Name_2 : Name_Id := No_Name; Error_Msg_Name_3 : Name_Id := No_Name; + Error_Msg_Name_4 : Name_Id := No_Name; + Error_Msg_Name_5 : Name_Id := No_Name; + Error_Msg_Name_6 : Name_Id := No_Name; -- Name_Id values for % insertion characters in message Error_Msg_File_1 : File_Name_Type; @@ -129,6 +137,10 @@ package Err_Vars is Error_Msg_Node_1 : Node_Id; Error_Msg_Node_2 : Node_Id := Empty; + Error_Msg_Node_3 : Node_Id := Empty; + Error_Msg_Node_4 : Node_Id := Empty; + Error_Msg_Node_5 : Node_Id := Empty; + Error_Msg_Node_6 : Node_Id := Empty; -- Node_Id values for & insertion characters in message Error_Msg_Warn : Boolean; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index b862637..44d461f 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3578,10 +3578,14 @@ package body Errout is end if; end if; - -- The following assignment ensures that a second ampersand insertion - -- character will correspond to the Error_Msg_Node_2 parameter. + -- The following assignment ensures that further ampersand insertion + -- characters will correspond to the Error_Msg_Node_# parameter. Error_Msg_Node_1 := Error_Msg_Node_2; + Error_Msg_Node_2 := Error_Msg_Node_3; + Error_Msg_Node_3 := Error_Msg_Node_4; + Error_Msg_Node_4 := Error_Msg_Node_5; + Error_Msg_Node_5 := Error_Msg_Node_6; end Set_Msg_Insertion_Node; -------------------------------------- @@ -3872,7 +3876,7 @@ package body Errout is -- dealing with some cases of internal names). while Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' loop - Name_Len := Name_Len - 1; + Name_Len := Name_Len - 1; end loop; -- If we have any of the names from standard that start with the diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 950dd55..ff36344 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -468,6 +468,9 @@ package Errout is Error_Msg_Name_1 : Name_Id renames Err_Vars.Error_Msg_Name_1; Error_Msg_Name_2 : Name_Id renames Err_Vars.Error_Msg_Name_2; Error_Msg_Name_3 : Name_Id renames Err_Vars.Error_Msg_Name_3; + Error_Msg_Name_4 : Name_Id renames Err_Vars.Error_Msg_Name_4; + Error_Msg_Name_5 : Name_Id renames Err_Vars.Error_Msg_Name_5; + Error_Msg_Name_6 : Name_Id renames Err_Vars.Error_Msg_Name_6; -- Name_Id values for % insertion characters in message Error_Msg_File_1 : File_Name_Type renames Err_Vars.Error_Msg_File_1; @@ -481,6 +484,10 @@ package Errout is Error_Msg_Node_1 : Node_Id renames Err_Vars.Error_Msg_Node_1; Error_Msg_Node_2 : Node_Id renames Err_Vars.Error_Msg_Node_2; + Error_Msg_Node_3 : Node_Id renames Err_Vars.Error_Msg_Node_3; + Error_Msg_Node_4 : Node_Id renames Err_Vars.Error_Msg_Node_4; + Error_Msg_Node_5 : Node_Id renames Err_Vars.Error_Msg_Node_5; + Error_Msg_Node_6 : Node_Id renames Err_Vars.Error_Msg_Node_6; -- Node_Id values for & insertion characters in message Error_Msg_Qual_Level : Nat renames Err_Vars.Error_Msg_Qual_Level; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index c18f418..d92ca33 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1319,12 +1319,15 @@ package body Erroutc is end if; end if; - -- The following assignments ensure that the second and third percent - -- insertion characters will correspond to the Error_Msg_Name_2 and - -- Error_Msg_Name_3 as required. + -- The following assignments ensure that other percent insertion + -- characters will correspond to their appropriate Error_Msg_Name_# + -- values as required. Error_Msg_Name_1 := Error_Msg_Name_2; Error_Msg_Name_2 := Error_Msg_Name_3; + Error_Msg_Name_3 := Error_Msg_Name_4; + Error_Msg_Name_4 := Error_Msg_Name_5; + Error_Msg_Name_5 := Error_Msg_Name_6; end Set_Msg_Insertion_Name; ------------------------------------ @@ -1348,12 +1351,15 @@ package body Erroutc is Set_Msg_Quote; end if; - -- The following assignments ensure that the second and third % or %% - -- insertion characters will correspond to the Error_Msg_Name_2 and - -- Error_Msg_Name_3 values. + -- The following assignments ensure that other percent insertion + -- characters will correspond to their appropriate Error_Msg_Name_# + -- values as required. Error_Msg_Name_1 := Error_Msg_Name_2; Error_Msg_Name_2 := Error_Msg_Name_3; + Error_Msg_Name_3 := Error_Msg_Name_4; + Error_Msg_Name_4 := Error_Msg_Name_5; + Error_Msg_Name_5 := Error_Msg_Name_6; end Set_Msg_Insertion_Name_Literal; ------------------------------------- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index e360baa..9e781e0 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7542,7 +7542,7 @@ package body Exp_Aggr is end Expand_Iterated_Component; - -- Start of processing for Expand_Container_Aggregate + -- Start of processing for Expand_Container_Aggregate begin Parse_Aspect_Aggregate (Asp, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 5374dd4..7b36dae 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -888,6 +888,11 @@ package body Exp_Attr is -- special stream-processing operations for that type (for example -- Unbounded_String and its wide varieties). + -- We don't install the package either if array type and element + -- type come from the same package, and the original array type is + -- private, because in this case the underlying type Arr is + -- itself a full view, which carries the full view of the component. + Scop := Scope (C_Type); if Is_Private_Type (C_Type) @@ -896,7 +901,15 @@ package body Exp_Attr is and then Ekind (Scop) = E_Package and then No (Get_Stream_Convert_Pragma (C_Type)) then - Install := True; + if Scope (Arr) = Scope (C_Type) + and then Is_Private_Type (Etype (Prefix (N))) + and then Full_View (Etype (Prefix (N))) = Arr + then + null; + + else + Install := True; + end if; end if; end if; @@ -6691,7 +6704,21 @@ package body Exp_Attr is Prefix_Is_Type := False; end if; - if Is_Class_Wide_Type (Ttyp) then + -- In the case of a class-wide equivalent type without a parent, + -- the _Tag component has been built in Make_CW_Equivalent_Type + -- manually and must be referenced directly. + + if Ekind (Ttyp) = E_Class_Wide_Subtype + and then Present (Equivalent_Type (Ttyp)) + and then No (Parent_Subtype (Equivalent_Type (Ttyp))) + then + Ttyp := Equivalent_Type (Ttyp); + + -- In all the other cases of class-wide type, including an equivalent + -- type with a parent, the _Tag component ultimately present is that + -- of the root type. + + elsif Is_Class_Wide_Type (Ttyp) then Ttyp := Root_Type (Ttyp); end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 50f46fb..97988bb 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1288,8 +1288,6 @@ package body Exp_Ch3 is Comp : Entity_Id; Comp_Type : Entity_Id; - -- Start of processing for Build_Equivalent_Record_Aggregate - begin if not Is_Record_Type (T) or else Has_Discriminants (T) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 2506c67..9de384a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -835,6 +835,7 @@ package body Exp_Ch4 is Make_Raise_Program_Error (Loc, Reason => PE_Accessibility_Check_Failed)); + Error_Msg_Warn := SPARK_Mode /= On; Error_Msg_N ("anonymous access discriminant is too deep for use" & " in allocator<<", N); Error_Msg_N ("\Program_Error [<<", N); @@ -11745,31 +11746,24 @@ package body Exp_Ch4 is declare Stored : constant Elist_Id := Stored_Constraint (Operand_Type); - - Elmt : Elmt_Id; + -- Stored constraints of the operand. If present, they + -- correspond to the discriminants of the parent type. Disc_O : Entity_Id; -- Discriminant of the operand type. Its value in the -- object is captured in a selected component. - Disc_S : Entity_Id; - -- Stored discriminant of the operand. If present, it - -- corresponds to a constrained discriminant of the - -- parent type. - Disc_T : Entity_Id; -- Discriminant of the target type + Elmt : Elmt_Id; + begin - Disc_T := First_Discriminant (Target_Type); Disc_O := First_Discriminant (Operand_Type); - Disc_S := First_Stored_Discriminant (Operand_Type); - - if Present (Stored) then - Elmt := First_Elmt (Stored); - else - Elmt := No_Elmt; -- init to avoid warning - end if; + Disc_T := First_Discriminant (Target_Type); + Elmt := (if Present (Stored) + then First_Elmt (Stored) + else No_Elmt); Cons := New_List; while Present (Disc_T) loop @@ -11784,8 +11778,11 @@ package body Exp_Ch4 is Make_Identifier (Loc, Chars (Disc_O)))); Next_Discriminant (Disc_O); - elsif Present (Disc_S) then + elsif Present (Elmt) then Append_To (Cons, New_Copy_Tree (Node (Elmt))); + end if; + + if Present (Elmt) then Next_Elmt (Elmt); end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index b38e3f5..710db66 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1848,27 +1848,14 @@ package body Exp_Ch5 is CI : constant List_Id := Component_Items (CL); VP : constant Node_Id := Variant_Part (CL); - Constrained_Typ : Entity_Id; - Alts : List_Id; - DC : Node_Id; - DCH : List_Id; - Expr : Node_Id; - Result : List_Id; - V : Node_Id; + Alts : List_Id; + DC : Node_Id; + DCH : List_Id; + Expr : Node_Id; + Result : List_Id; + V : Node_Id; begin - -- Try to find a constrained type to extract discriminant values - -- from, so that the case statement built below gets an - -- opportunity to be folded by Expand_N_Case_Statement. - - if U_U or else Is_Constrained (Etype (Rhs)) then - Constrained_Typ := Etype (Rhs); - elsif Is_Constrained (Etype (Expression (N))) then - Constrained_Typ := Etype (Expression (N)); - else - Constrained_Typ := Empty; - end if; - Result := Make_Field_Assigns (CI); if Present (VP) then @@ -1890,13 +1877,38 @@ package body Exp_Ch5 is Next_Non_Pragma (V); end loop; - if Present (Constrained_Typ) then + -- Try to find a constrained type or a derived type to extract + -- discriminant values from, so that the case statement built + -- below can be folded by Expand_N_Case_Statement. + + if U_U or else Is_Constrained (Etype (Rhs)) then + Expr := + New_Copy (Get_Discriminant_Value ( + Entity (Name (VP)), + Etype (Rhs), + Discriminant_Constraint (Etype (Rhs)))); + + elsif Is_Constrained (Etype (Expression (N))) then Expr := New_Copy (Get_Discriminant_Value ( Entity (Name (VP)), - Constrained_Typ, - Discriminant_Constraint (Constrained_Typ))); + Etype (Expression (N)), + Discriminant_Constraint (Etype (Expression (N))))); + + elsif Is_Derived_Type (Etype (Rhs)) + and then Present (Stored_Constraint (Etype (Rhs))) + then + Expr := + New_Copy (Get_Discriminant_Value ( + Corresponding_Record_Component (Entity (Name (VP))), + Etype (Etype (Rhs)), + Stored_Constraint (Etype (Rhs)))); + else + Expr := Empty; + end if; + + if No (Expr) or else not Compile_Time_Known_Value (Expr) then Expr := Make_Selected_Component (Loc, Prefix => Duplicate_Subexpr (Rhs), @@ -3563,8 +3575,7 @@ package body Exp_Ch5 is -- is ok here. -- pragma Assert - (not Is_Non_Empty_List - (Component_Associations (Pattern))); + (Is_Empty_List (Component_Associations (Pattern))); declare Agg_Length : constant Node_Id := diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f2d20af..e9967b4 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3817,11 +3817,11 @@ package body Exp_Disp is and then not Is_Actual_For_Formal_Incomplete_Type (Comp) then Error_Msg_Sloc := Sloc (Subp); - Error_Msg_Node_2 := Subp; - Error_Msg_Name_1 := Chars (Tagged_Type); Error_Msg_NE ("declaration must appear after completion of type &", N, Comp); + Error_Msg_Node_2 := Subp; + Error_Msg_Name_1 := Chars (Tagged_Type); Error_Msg_NE ("\which is a component of untagged type& in the profile " & "of primitive & of type % that is frozen by the " diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f434823..35ec250 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -2636,6 +2636,7 @@ package body Exp_Prag is Expression => Make_Variant_Comparison (Loc, Mode => Chars (Variant), + Typ => Expr_Typ, Curr_Val => New_Occurrence_Of (Curr_Id, Loc), Old_Val => New_Occurrence_Of (Old_Id, Loc))))); @@ -3000,6 +3001,7 @@ package body Exp_Prag is Expression => Make_Variant_Comparison (Loc, Mode => Chars (First (Choices (Variant))), + Typ => Expr_Typ, Curr_Val => New_Occurrence_Of (Curr_Id, Loc), Old_Val => New_Occurrence_Of (Old_Id, Loc))))); diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 90a626f..2fb9299 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -856,7 +856,7 @@ package body Exp_Unst is S : Entity_Id := E; begin - for J in reverse 1 .. L - 1 loop + for J in reverse 1 .. L - 1 loop S := Enclosing_Subprogram (S); Subps.Table (Subp_Index (S)).Reachable := True; end loop; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 64324bf..30c293c 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -890,6 +890,8 @@ package body Exp_Util is Size_Id : constant Entity_Id := Make_Temporary (Loc, 'S'); Actuals : List_Id; + Alloc_Nod : Node_Id := Empty; + Alloc_Expr : Node_Id := Empty; Fin_Addr_Id : Entity_Id; Fin_Mas_Act : Node_Id; Fin_Mas_Id : Entity_Id; @@ -897,6 +899,36 @@ package body Exp_Util is Subpool : Node_Id := Empty; begin + -- When we are building an allocator procedure, extract the allocator + -- node for later processing and calculation of alignment. + + if Is_Allocate then + + if Nkind (Expr) = N_Allocator then + Alloc_Nod := Expr; + + -- When Expr is an object declaration we have to examine its + -- expression. + + elsif Nkind (Expr) = N_Object_Declaration + and then Nkind (Expression (Expr)) = N_Allocator + then + Alloc_Nod := Expression (Expr); + + -- Otherwise, we raise an error because we should have found one + + else + raise Program_Error; + end if; + + -- Extract the qualified expression if there is one from the + -- allocator. + + if Nkind (Expression (Alloc_Nod)) = N_Qualified_Expression then + Alloc_Expr := Expression (Alloc_Nod); + end if; + end if; + -- Step 1: Construct all the actuals for the call to library routine -- Allocate_Any_Controlled / Deallocate_Any_Controlled. @@ -967,19 +999,27 @@ package body Exp_Util is Append_To (Actuals, New_Occurrence_Of (Addr_Id, Loc)); Append_To (Actuals, New_Occurrence_Of (Size_Id, Loc)); - if (Is_Allocate or else not Is_Class_Wide_Type (Desig_Typ)) + -- Class-wide allocations without expressions and non-class-wide + -- allocations can be performed without getting the alignment from + -- the type's Type Specific Record. + + if ((Is_Allocate and then No (Alloc_Expr)) + or else + not Is_Class_Wide_Type (Desig_Typ)) and then not Use_Secondary_Stack_Pool then Append_To (Actuals, New_Occurrence_Of (Alig_Id, Loc)); - -- For deallocation of class-wide types we obtain the value of - -- alignment from the Type Specific Record of the deallocated object. + -- For operations on class-wide types we obtain the value of + -- alignment from the Type Specific Record of the relevant object. -- This is needed because the frontend expansion of class-wide types -- into equivalent types confuses the back end. else -- Generate: -- Obj.all'Alignment + -- or + -- Alloc_Expr'Alignment -- ... because 'Alignment applied to class-wide types is expanded -- into the code that reads the value of alignment from the TSD @@ -992,7 +1032,10 @@ package body Exp_Util is Unchecked_Convert_To (RTE (RE_Storage_Offset), Make_Attribute_Reference (Loc, Prefix => - Make_Explicit_Dereference (Loc, Relocate_Node (Expr)), + (if No (Alloc_Expr) then + Make_Explicit_Dereference (Loc, Relocate_Node (Expr)) + else + Relocate_Node (Expression (Alloc_Expr))), Attribute_Name => Name_Alignment))); end if; @@ -6468,7 +6511,7 @@ package body Exp_Util is return Empty; end Check_Decls; - -- Start of processing for Following_Address_Clause + -- Start of processing for Following_Address_Clause begin -- If parser detected no address clause for the identifier in question, @@ -9480,8 +9523,8 @@ package body Exp_Util is -- Ext__50 : Storage_Array (1 .. (Exp'size - Typ'object_size)/8); -- end Equiv_T; -- - -- ??? Note that this type does not guarantee same alignment as all - -- derived types + -- Note that this type does not guarantee same alignment as all derived + -- types. -- -- Note: for the freezing circuitry, this looks like a record extension, -- and so we need to make sure that the scalar storage order is the same @@ -9539,7 +9582,8 @@ package body Exp_Util is if not Is_Interface (Root_Typ) then -- subtype rg__xx is - -- Storage_Offset range 1 .. (Expr'size - typ'size) / Storage_Unit + -- Storage_Offset range 1 .. (Expr'size - typ'object_size) + -- / Storage_Unit Sizexpr := Make_Op_Subtract (Loc, @@ -9554,13 +9598,20 @@ package body Exp_Util is Attribute_Name => Name_Object_Size)); else -- subtype rg__xx is - -- Storage_Offset range 1 .. Expr'size / Storage_Unit + -- Storage_Offset range 1 .. (Expr'size - Ada.Tags.Tag'object_size) + -- / Storage_Unit Sizexpr := - Make_Attribute_Reference (Loc, - Prefix => - OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), - Attribute_Name => Name_Size); + Make_Op_Subtract (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => + OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), + Attribute_Name => Name_Size), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (RTE (RE_Tag), Loc), + Attribute_Name => Name_Object_Size)); end if; Set_Paren_Count (Sizexpr, 1); @@ -9596,13 +9647,17 @@ package body Exp_Util is New_List (New_Occurrence_Of (Range_Type, Loc)))))); -- type Equiv_T is record - -- [ _parent : Tnn; ] - -- E : Str_Type; + -- _Parent : Snn; -- not interface + -- _Tag : Ada.Tags.Tag -- interface + -- Cnn : Str_Type; -- end Equiv_T; Equiv_Type := Make_Temporary (Loc, 'T'); Mutate_Ekind (Equiv_Type, E_Record_Type); - Set_Parent_Subtype (Equiv_Type, Constr_Root); + + if not Is_Interface (Root_Typ) then + Set_Parent_Subtype (Equiv_Type, Constr_Root); + end if; -- Set Is_Class_Wide_Equivalent_Type very early to trigger the special -- treatment for this type. In particular, even though _parent's type @@ -9630,6 +9685,17 @@ package body Exp_Util is (Equiv_Type, Reverse_Storage_Order (Base_Type (Root_Utyp))); Set_Reverse_Bit_Order (Equiv_Type, Reverse_Bit_Order (Base_Type (Root_Utyp))); + + else + Append_To (Comp_List, + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uTag), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Tag), Loc)))); end if; Append_To (Comp_List, @@ -9654,6 +9720,13 @@ package body Exp_Util is -- the generation of spurious warnings under ZFP run-time. Insert_Actions (E, List_Def, Suppress => All_Checks); + + -- In the case of an interface type mark the tag for First_Tag_Component + + if Is_Interface (Root_Typ) then + Set_Is_Tag (First_Entity (Equiv_Type)); + end if; + return Equiv_Type; end Make_CW_Equivalent_Type; @@ -10239,15 +10312,61 @@ package body Exp_Util is function Make_Variant_Comparison (Loc : Source_Ptr; + Typ : Entity_Id; Mode : Name_Id; Curr_Val : Node_Id; Old_Val : Node_Id) return Node_Id is + function Big_Integer_Lt return Entity_Id; + -- Returns the entity of the predefined "<" function from + -- Ada.Numerics.Big_Numbers.Big_Integers. + + -------------------- + -- Big_Integer_Lt -- + -------------------- + + function Big_Integer_Lt return Entity_Id is + Big_Integers : constant Entity_Id := + RTU_Entity (Ada_Numerics_Big_Numbers_Big_Integers); + + E : Entity_Id := First_Entity (Big_Integers); + + begin + while Present (E) loop + if Chars (E) = Name_Op_Lt then + return E; + end if; + Next_Entity (E); + end loop; + + raise Program_Error; + end Big_Integer_Lt; + + -- Start of processing for Make_Variant_Comparison + begin if Mode = Name_Increases then return Make_Op_Gt (Loc, Curr_Val, Old_Val); + else pragma Assert (Mode = Name_Decreases); - return Make_Op_Lt (Loc, Curr_Val, Old_Val); + + -- For discrete expressions use the "<" operator + + if Is_Discrete_Type (Typ) then + return Make_Op_Lt (Loc, Curr_Val, Old_Val); + + -- For Big_Integer expressions use the "<" function, because the + -- operator on private type might not be visible and won't be + -- resolved. + + else pragma Assert (Is_RTE (Base_Type (Typ), RE_Big_Integer)); + return + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (Big_Integer_Lt, Loc), + Parameter_Associations => + New_List (Curr_Val, Old_Val)); + end if; end if; end Make_Variant_Comparison; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 0233e56..d384567 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -901,12 +901,14 @@ package Exp_Util is function Make_Variant_Comparison (Loc : Source_Ptr; + Typ : Entity_Id; Mode : Name_Id; Curr_Val : Node_Id; Old_Val : Node_Id) return Node_Id; -- Subsidiary to the expansion of pragmas Loop_Variant and -- Subprogram_Variant. Generate a comparison between Curr_Val and Old_Val - -- depending on the variant mode (Increases / Decreases). + -- depending on the variant mode (Increases / Decreases) using less or + -- greater operator for Typ. procedure Map_Formals (Parent_Subp : Entity_Id; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7ed44f5..25bad46 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3581,7 +3581,7 @@ package body Freeze is end if; end Complain_CS; - -- Start of processing for Alias_Atomic_Check + -- Start of processing for Alias_Atomic_Check begin -- If object size of component type isn't known, we cannot diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 687e2e4..495c13d 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Jan 03, 2022 +GNAT Reference Manual , Apr 22, 2022 AdaCore @@ -1457,11 +1457,11 @@ EXTERNAL_PROPERTY_LIST ::= | (EXTERNAL_PROPERTY @{, EXTERNAL_PROPERTY@} ) EXTERNAL_PROPERTY ::= - Async_Readers [=> boolean_EXPRESSION] - | Async_Writers [=> boolean_EXPRESSION] - | Effective_Reads [=> boolean_EXPRESSION] - | Effective_Writes [=> boolean_EXPRESSION] - others => boolean_EXPRESSION + Async_Readers [=> static_boolean_EXPRESSION] + | Async_Writers [=> static_boolean_EXPRESSION] + | Effective_Reads [=> static_boolean_EXPRESSION] + | Effective_Writes [=> static_boolean_EXPRESSION] + others => static_boolean_EXPRESSION STATE_NAME ::= defining_identifier @@ -1983,7 +1983,7 @@ case, and it is recommended that these two options not be used together. Syntax: @example -pragma Async_Readers [ (boolean_EXPRESSION) ]; +pragma Async_Readers [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Async_Readers} in @@ -1997,7 +1997,7 @@ the SPARK 2014 Reference Manual, section 7.1.2. Syntax: @example -pragma Async_Writers [ (boolean_EXPRESSION) ]; +pragma Async_Writers [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Async_Writers} in @@ -2533,7 +2533,7 @@ clause), the GNAT uses the default alignment as described previously. Syntax: @example -pragma Constant_After_Elaboration [ (boolean_EXPRESSION) ]; +pragma Constant_After_Elaboration [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @@ -3060,7 +3060,7 @@ See Ada 2012 Reference Manual for details. Syntax: @example -pragma Effective_Reads [ (boolean_EXPRESSION) ]; +pragma Effective_Reads [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Effective_Reads} in @@ -3074,7 +3074,7 @@ the SPARK 2014 Reference Manual, section 7.1.2. Syntax: @example -pragma Effective_Writes [ (boolean_EXPRESSION) ]; +pragma Effective_Writes [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Effective_Writes} @@ -3852,7 +3852,7 @@ end Stacks; Syntax: @example -pragma Extensions_Visible [ (boolean_EXPRESSION) ]; +pragma Extensions_Visible [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Extensions_Visible} @@ -4079,7 +4079,7 @@ No other value of digits is permitted. Syntax: @example -pragma Ghost [ (boolean_EXPRESSION) ]; +pragma Ghost [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Ghost} in the SPARK @@ -5485,7 +5485,7 @@ earlier versions of the package body. Syntax: @example -pragma No_Caching [ (boolean_EXPRESSION) ]; +pragma No_Caching [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{No_Caching} in @@ -8837,7 +8837,7 @@ For the variable case, warnings are never given for unreferenced variables whose name contains one of the substrings @code{DISCARD, DUMMY, IGNORE, JUNK, UNUSED} in any casing. Such names are typically to be used in cases where such warnings are expected. -Thus it is never necessary to use @code{pragma Unmodified} for such +Thus it is never necessary to use @code{pragma Unused} for such variables, though it is harmless to do so. @node Pragma Validity_Checks,Pragma Volatile,Pragma Unused,Implementation Defined Pragmas @@ -8948,7 +8948,7 @@ access only part of the object in this case. Syntax: @example -pragma Volatile_Function [ (boolean_EXPRESSION) ]; +pragma Volatile_Function [ (static_boolean_EXPRESSION) ]; @end example For the semantics of this pragma, see the entry for aspect @code{Volatile_Function} diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 0199971..03ad454 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -721,7 +721,7 @@ procedure Gnatchop is begin Parse_Token (Source, Parse_Ptr, Token_Ptr); - if Source'Last + 1 - Token_Ptr < Literal'Length + if Source'Last + 1 - Token_Ptr < Literal'Length or else Source (Token_Ptr .. Token_Ptr + Literal'Length - 1) /= Literal then diff --git a/gcc/ada/gnatfind.adb b/gcc/ada/gnatfind.adb index 5df6a98..04b0fe4 100644 --- a/gcc/ada/gnatfind.adb +++ b/gcc/ada/gnatfind.adb @@ -86,7 +86,7 @@ procedure Gnatfind is procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - -- Start of processing for Parse_Cmd_Line + -- Start of processing for Parse_Cmd_Line begin -- First check for --version or --help diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 613a6b2..d599734 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -407,7 +407,7 @@ procedure Gnatlink is procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - -- Start of processing for Process_Args + -- Start of processing for Process_Args begin -- First, check for --version and --help diff --git a/gcc/ada/gnatxref.adb b/gcc/ada/gnatxref.adb index c9f234c..9499d11 100644 --- a/gcc/ada/gnatxref.adb +++ b/gcc/ada/gnatxref.adb @@ -74,7 +74,7 @@ procedure Gnatxref is procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - -- Start of processing for Parse_Cmd_Line + -- Start of processing for Parse_Cmd_Line begin -- First check for --version or --help diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index c6e40ff..36ec1d8 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -729,7 +729,7 @@ package body GPrep is procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - -- Start of processing for Scan_Command_Line + -- Start of processing for Scan_Command_Line begin -- First check for --version or --help diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 6b6ed5f..9eedffc 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1758,8 +1758,26 @@ extern size_t vxIntStackOverflowSize; #define INT_OVERFLOW_SIZE vxIntStackOverflowSize #endif -#ifdef VTHREADS -#include "private/vThreadsP.h" +/* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is. + handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp + doesn't. A similar issue is present VxWorks 7.2 and affects ZCX as well + as builtin_longjmp. This field only exists in Kernel mode, not RTP. */ +#if defined(VTHREADS) || (!defined(__RTP__) && (_WRS_VXWORKS_MAJOR >= 7)) +# ifdef VTHREADS +# include "private/vThreadsP.h" +# define EXCCNT vThreads.excCnt +# else +# include "private/taskLibP.h" +# define EXCCNT excCnt +# endif +# define CLEAR_EXCEPTION_COUNT() \ + do \ + { \ + WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf(); \ + currentTask->EXCCNT = 0; \ + } while (0) +#else +# define CLEAR_EXCEPTION_COUNT() #endif #ifndef __RTP__ @@ -1835,19 +1853,6 @@ __gnat_reset_guard_page (int sig) return FALSE; } -/* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is. - handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp - doesn't. */ -void -__gnat_clear_exception_count (void) -{ -#ifdef VTHREADS - WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf(); - - currentTask->vThreads.excCnt = 0; -#endif -} - /* Handle different SIGnal to exception mappings in different VxWorks versions. */ void @@ -1959,7 +1964,8 @@ __gnat_map_signal (int sig, break; } } - __gnat_clear_exception_count (); + + CLEAR_EXCEPTION_COUNT (); Raise_From_Signal_Handler (exception, msg); } diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index da67fd2..5944aed 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1330,9 +1330,7 @@ package body Inline is return; end if; - if Present (Declarations (N)) - and then Has_Excluded_Declaration (Spec_Id, Declarations (N)) - then + if Has_Excluded_Declaration (Spec_Id, Declarations (N)) then return; end if; @@ -2622,9 +2620,7 @@ package body Inline is -- Check excluded declarations - elsif Present (Declarations (N)) - and then Has_Excluded_Declaration (Spec_Id, Declarations (N)) - then + elsif Has_Excluded_Declaration (Spec_Id, Declarations (N)) then return; -- Check excluded statements. There is no need to protect us against @@ -4388,9 +4384,7 @@ package body Inline is return True; elsif Nkind (S) = N_Block_Statement then - if Present (Declarations (S)) - and then Has_Excluded_Declaration (Subp, Declarations (S)) - then + if Has_Excluded_Declaration (Subp, Declarations (S)) then return True; elsif Present (Handled_Statement_Sequence (S)) then diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 359e006..610a4bd 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -936,10 +936,10 @@ package body Lib.Xref is if Chars (BE) = Chars (E) then if Has_Pragma_Unused (E) then Error_Msg_NE -- CODEFIX - ("??pragma Unused given for&!", N, BE); + ("??aspect Unused specified for&!", N, BE); else Error_Msg_NE -- CODEFIX - ("??pragma Unreferenced given for&!", N, BE); + ("??aspect Unreferenced specified for&!", N, BE); end if; exit; end if; @@ -952,10 +952,10 @@ package body Lib.Xref is elsif Has_Pragma_Unused (E) then Error_Msg_NE -- CODEFIX - ("??pragma Unused given for&!", N, E); + ("??aspect Unused specified for&!", N, E); else Error_Msg_NE -- CODEFIX - ("??pragma Unreferenced given for&!", N, E); + ("??aspect Unreferenced specified for&!", N, E); end if; end if; diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb index 48950de..da20b93 100644 --- a/gcc/ada/libgnat/a-cfhama.adb +++ b/gcc/ada/libgnat/a-cfhama.adb @@ -151,7 +151,7 @@ is Insert (Target, N.Key, N.Element); end Insert_Element; - -- Start of processing for Assign + -- Start of processing for Assign begin if Target'Address = Source'Address then diff --git a/gcc/ada/libgnat/a-ngcefu.adb b/gcc/ada/libgnat/a-ngcefu.adb index eccb560..56beb0f 100644 --- a/gcc/ada/libgnat/a-ngcefu.adb +++ b/gcc/ada/libgnat/a-ngcefu.adb @@ -225,7 +225,7 @@ package body Ada.Numerics.Generic_Complex_Elementary_Functions is elsif abs Re (X) > 1.0 / Epsilon or else abs Im (X) > 1.0 / Epsilon then - Xt := Complex_One / X; + Xt := Complex_One / X; if Re (X) < 0.0 then Set_Re (Xt, PI - Re (Xt)); @@ -442,7 +442,7 @@ package body Ada.Numerics.Generic_Complex_Elementary_Functions is if abs Re (X) < Square_Root_Epsilon and then abs Im (X) < Square_Root_Epsilon then - return Complex_One / X; + return Complex_One / X; elsif Im (X) > Log_Inverse_Epsilon_2 then return -Complex_I; @@ -463,7 +463,7 @@ package body Ada.Numerics.Generic_Complex_Elementary_Functions is if abs Re (X) < Square_Root_Epsilon and then abs Im (X) < Square_Root_Epsilon then - return Complex_One / X; + return Complex_One / X; elsif Re (X) > Log_Inverse_Epsilon_2 then return Complex_One; diff --git a/gcc/ada/libgnat/a-strunb.adb b/gcc/ada/libgnat/a-strunb.adb index e97ee3d..f8e880e 100644 --- a/gcc/ada/libgnat/a-strunb.adb +++ b/gcc/ada/libgnat/a-strunb.adb @@ -721,7 +721,7 @@ package body Ada.Strings.Unbounded is Realloc_For_Chunk (Source, New_Item'Length); Source.Reference - (Before + New_Item'Length .. Source.Last + New_Item'Length) := + (Before + New_Item'Length .. Source.Last + New_Item'Length) := Source.Reference (Before .. Source.Last); Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item; diff --git a/gcc/ada/libgnat/a-stwiun.adb b/gcc/ada/libgnat/a-stwiun.adb index 76fc2ea..8773a62 100644 --- a/gcc/ada/libgnat/a-stwiun.adb +++ b/gcc/ada/libgnat/a-stwiun.adb @@ -718,7 +718,7 @@ package body Ada.Strings.Wide_Unbounded is Realloc_For_Chunk (Source, New_Item'Length); Source.Reference - (Before + New_Item'Length .. Source.Last + New_Item'Length) := + (Before + New_Item'Length .. Source.Last + New_Item'Length) := Source.Reference (Before .. Source.Last); Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item; diff --git a/gcc/ada/libgnat/a-stzunb.adb b/gcc/ada/libgnat/a-stzunb.adb index 34cbc32..a92714c 100644 --- a/gcc/ada/libgnat/a-stzunb.adb +++ b/gcc/ada/libgnat/a-stzunb.adb @@ -726,7 +726,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is Realloc_For_Chunk (Source, New_Item'Length); Source.Reference - (Before + New_Item'Length .. Source.Last + New_Item'Length) := + (Before + New_Item'Length .. Source.Last + New_Item'Length) := Source.Reference (Before .. Source.Last); Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item; diff --git a/gcc/ada/libgnat/a-wtedit.adb b/gcc/ada/libgnat/a-wtedit.adb index 64bb989..9b9f702 100644 --- a/gcc/ada/libgnat/a-wtedit.adb +++ b/gcc/ada/libgnat/a-wtedit.adb @@ -246,8 +246,8 @@ package body Ada.Wide_Text_IO.Editing is else Count := Count * 10 - + Character'Pos (Picture (Last)) - - Character'Pos ('0'); + + Character'Pos (Picture (Last)) - + Character'Pos ('0'); end if; Last := Last + 1; diff --git a/gcc/ada/libgnat/g-alleve.adb b/gcc/ada/libgnat/g-alleve.adb index 0dba029..4db442c 100644 --- a/gcc/ada/libgnat/g-alleve.adb +++ b/gcc/ada/libgnat/g-alleve.adb @@ -3779,7 +3779,7 @@ package body GNAT.Altivec.Low_Level_Vectors is return D; end Saturate; - -- Start of processing for vpksxus + -- Start of processing for vpksxus begin for J in 0 .. N - 1 loop diff --git a/gcc/ada/libgnat/g-debpoo.adb b/gcc/ada/libgnat/g-debpoo.adb index ecab282..6e0cf10 100644 --- a/gcc/ada/libgnat/g-debpoo.adb +++ b/gcc/ada/libgnat/g-debpoo.adb @@ -791,7 +791,7 @@ package body GNAT.Debug_Pools is declare Block_Number : constant Integer_Address := - Int_Storage / Memory_Chunk_Size; + Int_Storage / Memory_Chunk_Size; Ptr : constant Validity_Bits_Ref := Validy_Htable.Get (Block_Number); Offset : constant Integer_Address := @@ -844,7 +844,7 @@ package body GNAT.Debug_Pools is procedure Set_Valid (Storage : System.Address; Value : Boolean) is Int_Storage : constant Integer_Address := To_Integer (Storage); Block_Number : constant Integer_Address := - Int_Storage / Memory_Chunk_Size; + Int_Storage / Memory_Chunk_Size; Ptr : Validity_Bits_Ref := Validy_Htable.Get (Block_Number); Offset : constant Integer_Address := (Int_Storage - (Block_Number * Memory_Chunk_Size)) / diff --git a/gcc/ada/libgnat/g-expect.adb b/gcc/ada/libgnat/g-expect.adb index e43ef4f..56554c0 100644 --- a/gcc/ada/libgnat/g-expect.adb +++ b/gcc/ada/libgnat/g-expect.adb @@ -96,7 +96,7 @@ package body GNAT.Expect is procedure Dup2 (Old_Fd, New_Fd : File_Descriptor); pragma Import (C, Dup2); - procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); + procedure Kill (Pid : Process_Id; Sig_Num : Integer); pragma Import (C, Kill, "__gnat_kill"); -- if Close is set to 1 all OS resources used by the Pid must be freed @@ -222,6 +222,10 @@ package body GNAT.Expect is Next_Filter : Filter_List; begin + if Descriptor.Pid > 0 then -- see comment in Send_Signal + Kill (Descriptor.Pid, Sig_Num => 9); + end if; + Close_Input (Descriptor); if Descriptor.Error_Fd /= Descriptor.Output_Fd @@ -234,12 +238,6 @@ package body GNAT.Expect is Close (Descriptor.Output_Fd); end if; - -- ??? Should have timeouts for different signals - - if Descriptor.Pid > 0 then -- see comment in Send_Signal - Kill (Descriptor.Pid, Sig_Num => 9, Close => 0); - end if; - GNAT.OS_Lib.Free (Descriptor.Buffer); Descriptor.Buffer_Size := 0; @@ -1349,7 +1347,7 @@ package body GNAT.Expect is -- started; we don't want to kill ourself in that case. if Descriptor.Pid > 0 then - Kill (Descriptor.Pid, Signal, Close => 1); + Kill (Descriptor.Pid, Signal); -- ??? Need to check process status here else raise Invalid_Process; diff --git a/gcc/ada/libgnat/s-expmod.adb b/gcc/ada/libgnat/s-expmod.adb index 60d86e5..527338d 100644 --- a/gcc/ada/libgnat/s-expmod.adb +++ b/gcc/ada/libgnat/s-expmod.adb @@ -251,9 +251,6 @@ is pragma Loop_Invariant (Equal_Modulo (Big (Result) * Big (Factor) ** Exp, Big (Left) ** Right)); pragma Loop_Variant (Decreases => Exp); - pragma Annotate - (CodePeer, False_Positive, - "validity check", "confusion on generated code"); if Exp rem 2 /= 0 then pragma Assert diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index 0681580..5af6586 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -1602,15 +1602,15 @@ package body System.OS_Lib is SIGKILL : constant := 9; SIGINT : constant := 2; - procedure C_Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); + procedure C_Kill (Pid : Process_Id; Sig_Num : Integer); pragma Import (C, C_Kill, "__gnat_kill"); begin if Pid /= Invalid_Pid then if Hard_Kill then - C_Kill (Pid, SIGKILL, 1); + C_Kill (Pid, SIGKILL); else - C_Kill (Pid, SIGINT, 1); + C_Kill (Pid, SIGINT); end if; end if; end Kill; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 3ac4fd5..af76dc7 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1971,9 +1971,9 @@ package body Osint is function Nb_Dir_In_Obj_Search_Path return Natural is begin if Opt.Look_In_Primary_Dir then - return Lib_Search_Directories.Last - Primary_Directory + 1; + return Lib_Search_Directories.Last - Primary_Directory + 1; else - return Lib_Search_Directories.Last - Primary_Directory; + return Lib_Search_Directories.Last - Primary_Directory; end if; end Nb_Dir_In_Obj_Search_Path; @@ -1984,9 +1984,9 @@ package body Osint is function Nb_Dir_In_Src_Search_Path return Natural is begin if Opt.Look_In_Primary_Dir then - return Src_Search_Directories.Last - Primary_Directory + 1; + return Src_Search_Directories.Last - Primary_Directory + 1; else - return Src_Search_Directories.Last - Primary_Directory; + return Src_Search_Directories.Last - Primary_Directory; end if; end Nb_Dir_In_Src_Search_Path; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 6f1f50f..88f27f0 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1266,8 +1266,7 @@ begin elsif Nkind (A) = N_Character_Literal then declare - R : constant Char_Code := - Char_Code (UI_To_Int (Char_Literal_Value (A))); + R : constant Char_Code := UI_To_CC (Char_Literal_Value (A)); begin if In_Character_Range (R) then Wide_Character_Encoding_Method := diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index b77ff4a..ed7312c 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -44,6 +44,7 @@ with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; +with Stand; use Stand; with Stringt; use Stringt; with Table; with Ttypes; @@ -874,10 +875,11 @@ package body Repinfo is C : Character; begin - -- List the qualified name recursively, except - -- at compilation unit level in default mode. + -- In JSON mode, we recurse up to Standard. This is also valid in + -- default mode where we recurse up to the first compilation unit and + -- should not get to Standard. - if Is_Compilation_Unit (Ent) then + if Scope (Ent) = Standard_Standard then null; elsif not Is_Compilation_Unit (Scope (Ent)) or else List_Representation_Info_To_JSON diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 6808efa..cda13d4 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -564,8 +564,12 @@ package body Rtsfind is Ada_Interrupts_Names .. Ada_Interrupts_Names; subtype Ada_Numerics_Descendant is Ada_Descendant - range Ada_Numerics_Generic_Elementary_Functions .. - Ada_Numerics_Generic_Elementary_Functions; + range Ada_Numerics_Big_Numbers .. + Ada_Numerics_Big_Numbers_Big_Integers_Ghost; + + subtype Ada_Numerics_Big_Numbers_Descendant is Ada_Descendant + range Ada_Numerics_Big_Numbers_Big_Integers .. + Ada_Numerics_Big_Numbers_Big_Integers_Ghost; subtype Ada_Real_Time_Descendant is Ada_Descendant range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events; @@ -657,6 +661,10 @@ package body Rtsfind is elsif U_Id in Ada_Numerics_Descendant then Name_Buffer (13) := '.'; + if U_Id in Ada_Numerics_Big_Numbers_Descendant then + Name_Buffer (25) := '.'; + end if; + elsif U_Id in Ada_Real_Time_Descendant then Name_Buffer (14) := '.'; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index e174e75..8c831f0 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -115,8 +115,14 @@ package Rtsfind is -- Children of Ada.Numerics + Ada_Numerics_Big_Numbers, Ada_Numerics_Generic_Elementary_Functions, + -- Children of Ada.Numerics.Big_Numbers + + Ada_Numerics_Big_Numbers_Big_Integers, + Ada_Numerics_Big_Numbers_Big_Integers_Ghost, + -- Children of Ada.Real_Time Ada_Real_Time_Delays, @@ -585,6 +591,9 @@ package Rtsfind is RE_Detach_Handler, -- Ada.Interrupts RE_Reference, -- Ada.Interrupts + RE_Big_Integer, -- Ada.Numerics.Big_Numbers.Big_Integers + RO_GH_Big_Integer, -- Ada.Numerics.Big_Numbers.Big_Integers_Ghost + RE_Names, -- Ada.Interrupts.Names RE_Clock, -- Ada.Real_Time @@ -2271,6 +2280,9 @@ package Rtsfind is RE_Detach_Handler => Ada_Interrupts, RE_Reference => Ada_Interrupts, + RE_Big_Integer => Ada_Numerics_Big_Numbers_Big_Integers, + RO_GH_Big_Integer => Ada_Numerics_Big_Numbers_Big_Integers_Ghost, + RE_Names => Ada_Interrupts_Names, RE_Clock => Ada_Real_Time, diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index c88826a..ea64690 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -380,22 +380,22 @@ package body Sem is Analyze_Arithmetic_Op (N); when N_Op_Eq => - Analyze_Equality_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Expon => Analyze_Arithmetic_Op (N); when N_Op_Ge => - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Gt => - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Le => - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Lt => - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Minus => Analyze_Unary_Op (N); @@ -407,7 +407,7 @@ package body Sem is Analyze_Arithmetic_Op (N); when N_Op_Ne => - Analyze_Equality_Op (N); + Analyze_Comparison_Equality_Op (N); when N_Op_Not => Analyze_Negation (N); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 33179aa..4748567 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2693,8 +2693,6 @@ package body Sem_Attr is procedure Check_Task_Prefix is begin - Analyze (P); - -- Ada 2005 (AI-345): Attribute 'Terminated can be applied to -- task interface class-wide types. @@ -3421,7 +3419,6 @@ package body Sem_Attr is New_Occurrence_Of (RTE (RE_Low_Order_First), Loc)); end if; - Set_Etype (N, RTE (RE_Bit_Order)); Resolve (N); -- Reset incorrect indication of staticness @@ -4302,7 +4299,6 @@ package body Sem_Attr is when Attribute_Identity => Check_E0; - Analyze (P); if Etype (P) = Standard_Exception_Type then Set_Etype (N, RTE (RE_Exception_Id)); @@ -5506,8 +5502,6 @@ package body Sem_Attr is -- The prefix must be a protected object (AARM D.5.2 (2/2)) - Analyze (P); - if Is_Protected_Type (Etype (P)) or else (Is_Access_Type (Etype (P)) and then Is_Protected_Type (Designated_Type (Etype (P)))) @@ -5847,7 +5841,6 @@ package body Sem_Attr is when Attribute_Ref => Check_E1; - Analyze (P); if Nkind (P) /= N_Expanded_Name or else not Is_RTE (P_Type, RE_Address) @@ -5875,7 +5868,6 @@ package body Sem_Attr is begin Check_E1; - Analyze (P); Check_System_Prefix; -- No_Dependence case @@ -6457,7 +6449,6 @@ package body Sem_Attr is Val : Uint; begin Check_E1; - Analyze (P); Check_System_Prefix; Generate_Reference (RTE (RE_Address), P); diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index da8f3cc..88948f7 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -410,8 +410,10 @@ package body Sem_Aux is Ctyp : Entity_Id; begin + pragma Assert (Is_Tagged_Type (Typ) + or else Is_Class_Wide_Equivalent_Type (Typ)); + Ctyp := Typ; - pragma Assert (Is_Tagged_Type (Ctyp)); if Is_Class_Wide_Type (Ctyp) then Ctyp := Root_Type (Ctyp); diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index fed9f4d..ccd4b18 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -1104,7 +1104,7 @@ package body Sem_Case is C := UI_To_Int (Value); if C in 16#20# .. 16#7E# then - Set_Character_Literal_Name (Char_Code (UI_To_Int (Value))); + Set_Character_Literal_Name (UI_To_CC (Value)); return Name_Find; end if; @@ -2925,7 +2925,7 @@ package body Sem_Case is -- is created with the appropriate Char_Code and Chars fields. if Is_Standard_Character_Type (Choice_Type) then - Set_Character_Literal_Name (Char_Code (UI_To_Int (Value))); + Set_Character_Literal_Name (UI_To_CC (Value)); Lit := Make_Character_Literal (Loc, Chars => Name_Find, diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5eeaf3d..f01562d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -17192,7 +17192,7 @@ package body Sem_Ch12 is end if; end Validate_Derived_Type_Default; - -- Start of processing for Validate_Formal_Type_Default + -- Start of processing for Validate_Formal_Type_Default begin Analyze (Default); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 78415e6..cfbb066 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12449,7 +12449,7 @@ package body Sem_Ch13 is OC_Lbit (To) := OC_Lbit (From); end OC_Move; - -- Start of processing for Overlap_Check + -- Start of processing for Overlap_Check begin CC := First (Component_Clauses (N)); @@ -15176,27 +15176,26 @@ package body Sem_Ch13 is end if; -- The components of the type are directly visible and can - -- be referenced without a prefix. - - if Nkind (Parent (N)) = N_Selected_Component then - null; - - -- In expression C (I), C may be a directly visible function - -- or a visible component that has an array type. Disambiguate - -- by examining the component type. + -- be referenced in the source code without a prefix. + -- If a name denoting a component doesn't already have a + -- prefix, then normalize it by adding a reference to the + -- current instance of the type as a prefix. + -- + -- This isn't right in the pathological corner case of an + -- object-declaring expression (e.g., a quantified expression + -- or a declare expression) that declares an object with the + -- same name as a visible component declaration, thereby hiding + -- the component within that expression. For example, given a + -- record with a Boolean component "C" and a dynamic predicate + -- "C = (for some C in Character => Some_Function (C))", only + -- the first of the two uses of C should have a prefix added + -- here; instead, both will get prefixes. - elsif Nkind (Parent (N)) = N_Indexed_Component - and then N = Prefix (Parent (N)) + if Nkind (Parent (N)) /= N_Selected_Component + or else N /= Selector_Name (Parent (N)) then Comp := Visible_Component (Chars (N)); - if Present (Comp) and then Is_Array_Type (Etype (Comp)) then - Add_Prefix (N, Comp); - end if; - - else - Comp := Visible_Component (Chars (N)); - if Present (Comp) then Add_Prefix (N, Comp); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2e207c1..a88f7f2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -40,6 +40,7 @@ with Exp_Disp; use Exp_Disp; with Exp_Dist; use Exp_Dist; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; +with Expander; use Expander; with Freeze; use Freeze; with Ghost; use Ghost; with Itypes; use Itypes; @@ -20387,6 +20388,40 @@ package body Sem_Ch3 is In_Assertion_Expr := In_Assertion_Expr - 1; end Preanalyze_Assert_Expression; + -- ??? The variant below explicitly saves and restores all the flags, + -- because it is impossible to compose the existing variety of + -- Analyze/Resolve (and their wrappers, e.g. Preanalyze_Spec_Expression) + -- to achieve the desired semantics. + + procedure Preanalyze_Assert_Expression (N : Node_Id) is + Save_In_Spec_Expression : constant Boolean := In_Spec_Expression; + Save_Must_Not_Freeze : constant Boolean := Must_Not_Freeze (N); + Save_Full_Analysis : constant Boolean := Full_Analysis; + + begin + In_Assertion_Expr := In_Assertion_Expr + 1; + In_Spec_Expression := True; + Set_Must_Not_Freeze (N); + Inside_Preanalysis_Without_Freezing := + Inside_Preanalysis_Without_Freezing + 1; + Full_Analysis := False; + Expander_Mode_Save_And_Set (False); + + if GNATprove_Mode then + Analyze_And_Resolve (N); + else + Analyze_And_Resolve (N, Suppress => All_Checks); + end if; + + Expander_Mode_Restore; + Full_Analysis := Save_Full_Analysis; + Inside_Preanalysis_Without_Freezing := + Inside_Preanalysis_Without_Freezing - 1; + Set_Must_Not_Freeze (N, Save_Must_Not_Freeze); + In_Spec_Expression := Save_In_Spec_Expression; + In_Assertion_Expr := In_Assertion_Expr - 1; + end Preanalyze_Assert_Expression; + ----------------------------------- -- Preanalyze_Default_Expression -- ----------------------------------- diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index e45ed6c..62b15c0 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -235,6 +235,9 @@ package Sem_Ch3 is -- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that -- In_Assertion_Expr can be properly adjusted. + procedure Preanalyze_Assert_Expression (N : Node_Id); + -- Similar to the above, but without forcing N to be of a particular type + procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id); -- Default and per object expressions do not freeze their components, and -- must be analyzed and resolved accordingly. The analysis is done by diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 918f3b8..915a7b4 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -148,10 +148,6 @@ package body Sem_Ch4 is -- like a function, but instead of a list of actuals, it is presented with -- the operand of the operator node. - procedure Ambiguous_Operands (N : Node_Id); - -- For equality, membership, and comparison operators with overloaded - -- arguments, list possible interpretations. - procedure Analyze_One_Call (N : Node_Id; Nam : Entity_Id; @@ -184,12 +180,6 @@ package body Sem_Ch4 is -- Analyze_Selected_Component after producing an invalid selector error -- message. - function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean; - -- Verify that type T is declared in scope S. Used to find interpretations - -- for operators given by expanded names. This is abstracted as a separate - -- function to handle extensions to System, where S is System, but T is - -- declared in the extension. - procedure Find_Arithmetic_Types (L, R : Node_Id; Op_Id : Entity_Id; @@ -198,12 +188,12 @@ package body Sem_Ch4 is -- pairs of interpretations for L and R that have a numeric type consistent -- with the semantics of the operator. - procedure Find_Comparison_Types + procedure Find_Comparison_Equality_Types (L, R : Node_Id; Op_Id : Entity_Id; N : Node_Id); - -- L and R are operands of a comparison operator. Find consistent pairs of - -- interpretations for L and R. + -- L and R are operands of a comparison or equality operator. Find valid + -- pairs of interpretations for L and R. procedure Find_Concatenation_Types (L, R : Node_Id; @@ -211,12 +201,6 @@ package body Sem_Ch4 is N : Node_Id); -- For the four varieties of concatenation - procedure Find_Equality_Types - (L, R : Node_Id; - Op_Id : Entity_Id; - N : Node_Id); - -- Ditto for equality operators - procedure Find_Boolean_Types (L, R : Node_Id; Op_Id : Entity_Id; @@ -229,18 +213,6 @@ package body Sem_Ch4 is N : Node_Id); -- Find consistent interpretation for operand of negation operator - procedure Find_Non_Universal_Interpretations - (N : Node_Id; - R : Node_Id; - Op_Id : Entity_Id; - T1 : Entity_Id); - -- For equality and comparison operators, the result is always boolean, and - -- the legality of the operation is determined from the visibility of the - -- operand types. If one of the operands has a universal interpretation, - -- the legality check uses some compatible non-universal interpretation of - -- the other operand. N can be an operator node, or a function call whose - -- name is an operator designator. - function Find_Primitive_Operation (N : Node_Id) return Boolean; -- Find candidate interpretations for the name Obj.Proc when it appears in -- a subprogram renaming declaration. @@ -911,12 +883,15 @@ package body Sem_Ch4 is --------------------------- procedure Analyze_Arithmetic_Op (N : Node_Id) is - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); + Op_Id : Entity_Id; begin + Set_Etype (N, Any_Type); Candidate_Type := Empty; + Analyze_Expression (L); Analyze_Expression (R); @@ -926,22 +901,18 @@ package body Sem_Ch4 is -- and we do not need to collect interpretations, instead we just get -- the single possible interpretation. - Op_Id := Entity (N); + if Present (Entity (N)) then + Op_Id := Entity (N); - if Present (Op_Id) then if Ekind (Op_Id) = E_Operator then - Set_Etype (N, Any_Type); Find_Arithmetic_Types (L, R, Op_Id, N); else - Set_Etype (N, Any_Type); Add_One_Interp (N, Op_Id, Etype (Op_Id)); end if; -- Entity is not already set, so we do need to collect interpretations else - Set_Etype (N, Any_Type); - Op_Id := Get_Name_Entity_Id (Chars (N)); while Present (Op_Id) loop if Ekind (Op_Id) = E_Operator @@ -1762,50 +1733,6 @@ package body Sem_Ch4 is end Analyze_Case_Expression; --------------------------- - -- Analyze_Comparison_Op -- - --------------------------- - - procedure Analyze_Comparison_Op (N : Node_Id) is - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); - Op_Id : Entity_Id := Entity (N); - - begin - Set_Etype (N, Any_Type); - Candidate_Type := Empty; - - Analyze_Expression (L); - Analyze_Expression (R); - - if Present (Op_Id) then - if Ekind (Op_Id) = E_Operator then - Find_Comparison_Types (L, R, Op_Id, N); - else - Add_One_Interp (N, Op_Id, Etype (Op_Id)); - end if; - - if Is_Overloaded (L) then - Set_Etype (L, Intersect_Types (L, R)); - end if; - - else - Op_Id := Get_Name_Entity_Id (Chars (N)); - while Present (Op_Id) loop - if Ekind (Op_Id) = E_Operator then - Find_Comparison_Types (L, R, Op_Id, N); - else - Analyze_User_Defined_Binary_Op (N, Op_Id); - end if; - - Op_Id := Homonym (Op_Id); - end loop; - end if; - - Operator_Check (N); - Check_Function_Writable_Actuals (N); - end Analyze_Comparison_Op; - - --------------------------- -- Analyze_Concatenation -- --------------------------- @@ -1956,14 +1883,15 @@ package body Sem_Ch4 is Operator_Check (N); end Analyze_Concatenation_Rest; - ------------------------- - -- Analyze_Equality_Op -- - ------------------------- + ------------------------------------ + -- Analyze_Comparison_Equality_Op -- + ------------------------------------ + + procedure Analyze_Comparison_Equality_Op (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); - procedure Analyze_Equality_Op (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); Op_Id : Entity_Id; begin @@ -1980,9 +1908,9 @@ package body Sem_Ch4 is -- For the predefined case, the result is Boolean, regardless of the -- type of the operands. The operands may even be limited, if they are - -- generic actuals. If they are overloaded, label the left argument with - -- the common type that must be present, or with the type of the formal - -- of the user-defined function. + -- generic actuals. If they are overloaded, label the operands with the + -- common type that must be present, or with the type of the formal of + -- the user-defined function. if Present (Entity (N)) then Op_Id := Entity (N); @@ -2001,11 +1929,20 @@ package body Sem_Ch4 is end if; end if; + if Is_Overloaded (R) then + if Ekind (Op_Id) = E_Operator then + Set_Etype (R, Intersect_Types (L, R)); + else + Set_Etype (R, Etype (Next_Formal (First_Formal (Op_Id)))); + end if; + end if; + else Op_Id := Get_Name_Entity_Id (Chars (N)); + while Present (Op_Id) loop if Ekind (Op_Id) = E_Operator then - Find_Equality_Types (L, R, Op_Id, N); + Find_Comparison_Equality_Types (L, R, Op_Id, N); else Analyze_User_Defined_Binary_Op (N, Op_Id); end if; @@ -2026,7 +1963,7 @@ package body Sem_Ch4 is Op_Id := Get_Name_Entity_Id (Name_Op_Eq); while Present (Op_Id) loop if Ekind (Op_Id) = E_Operator then - Find_Equality_Types (L, R, Op_Id, N); + Find_Comparison_Equality_Types (L, R, Op_Id, N); else Analyze_User_Defined_Binary_Op (N, Op_Id); end if; @@ -2051,7 +1988,7 @@ package body Sem_Ch4 is Operator_Check (N); Check_Function_Writable_Actuals (N); - end Analyze_Equality_Op; + end Analyze_Comparison_Equality_Op; ---------------------------------- -- Analyze_Explicit_Dereference -- @@ -2259,7 +2196,6 @@ package body Sem_Ch4 is procedure Analyze_Expression (N : Node_Id) is begin - -- If the expression is an indexed component that will be rewritten -- as a container indexing, it has already been analyzed. @@ -2909,9 +2845,10 @@ package body Sem_Ch4 is ------------------------ procedure Analyze_Logical_Op (N : Node_Id) is - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); - Op_Id : Entity_Id := Entity (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); + + Op_Id : Entity_Id; begin Set_Etype (N, Any_Type); @@ -2920,7 +2857,14 @@ package body Sem_Ch4 is Analyze_Expression (L); Analyze_Expression (R); - if Present (Op_Id) then + -- If the entity is already set, the node is the instantiation of a + -- generic node with a non-local reference, or was manufactured by a + -- call to Make_Op_xxx. In either case the entity is known to be valid, + -- and we do not need to collect interpretations, instead we just get + -- the single possible interpretation. + + if Present (Entity (N)) then + Op_Id := Entity (N); if Ekind (Op_Id) = E_Operator then Find_Boolean_Types (L, R, Op_Id, N); @@ -2928,6 +2872,8 @@ package body Sem_Ch4 is Add_One_Interp (N, Op_Id, Etype (Op_Id)); end if; + -- Entity is not already set, so we do need to collect interpretations + else Op_Id := Get_Name_Entity_Id (Chars (N)); while Present (Op_Id) loop @@ -2954,25 +2900,24 @@ package body Sem_Ch4 is L : constant Node_Id := Left_Opnd (N); R : constant Node_Id := Right_Opnd (N); - Index : Interp_Index; - It : Interp; - Found : Boolean := False; - I_F : Interp_Index; - T_F : Entity_Id; - procedure Analyze_Set_Membership; -- If a set of alternatives is present, analyze each and find the -- common type to which they must all resolve. - procedure Find_Interpretation; - function Find_Interpretation return Boolean; - -- Routine and wrapper to find a matching interpretation + function Find_Interp return Boolean; + -- Find a valid interpretation of the test. Note that the context of the + -- operation plays no role in resolving the operands, so that if there + -- is more than one interpretation of the operands that is compatible + -- with the test, the operation is ambiguous. - procedure Try_One_Interp (T1 : Entity_Id); - -- Routine to try one proposed interpretation. Note that the context - -- of the operation plays no role in resolving the arguments, so that - -- if there is more than one interpretation of the operands that is - -- compatible with a membership test, the operation is ambiguous. + function Try_Left_Interp (T : Entity_Id) return Boolean; + -- Try an interpretation of the left operand with type T. Return true if + -- one interpretation (at least) of the right operand making up a valid + -- operand pair exists, otherwise false if no such pair exists. + + function Is_Valid_Pair (T1, T2 : Entity_Id) return Boolean; + -- Return true if T1 and T2 constitute a valid pair of operand types for + -- L and R respectively. ---------------------------- -- Analyze_Set_Membership -- @@ -3055,8 +3000,6 @@ package body Sem_Ch4 is end loop; end if; - Set_Etype (N, Standard_Boolean); - if Present (Common_Type) then Set_Etype (L, Common_Type); @@ -3068,63 +3011,134 @@ package body Sem_Ch4 is end if; end Analyze_Set_Membership; - ------------------------- - -- Find_Interpretation -- - ------------------------- + ----------------- + -- Find_Interp -- + ----------------- + + function Find_Interp return Boolean is + Found : Boolean; + I : Interp_Index; + It : Interp; + L_Typ : Entity_Id; + Valid_I : Interp_Index; - procedure Find_Interpretation is begin + -- Loop through the interpretations of the left operand + if not Is_Overloaded (L) then - Try_One_Interp (Etype (L)); + Found := Try_Left_Interp (Etype (L)); else - Get_First_Interp (L, Index, It); + Found := False; + L_Typ := Empty; + Valid_I := 0; + + Get_First_Interp (L, I, It); while Present (It.Typ) loop - Try_One_Interp (It.Typ); - Get_Next_Interp (Index, It); + if Try_Left_Interp (It.Typ) then + -- If several interpretations are possible, disambiguate + + if Present (L_Typ) + and then Base_Type (It.Typ) /= Base_Type (L_Typ) + then + It := Disambiguate (L, Valid_I, I, Any_Type); + + if It = No_Interp then + Ambiguous_Operands (N); + Set_Etype (L, Any_Type); + return True; + end if; + + else + Valid_I := I; + end if; + + L_Typ := It.Typ; + Set_Etype (L, L_Typ); + Found := True; + end if; + + Get_Next_Interp (I, It); end loop; end if; - end Find_Interpretation; - - function Find_Interpretation return Boolean is - begin - Find_Interpretation; return Found; - end Find_Interpretation; + end Find_Interp; - -------------------- - -- Try_One_Interp -- - -------------------- + --------------------- + -- Try_Left_Interp -- + --------------------- + + function Try_Left_Interp (T : Entity_Id) return Boolean is + Found : Boolean; + I : Interp_Index; + It : Interp; + R_Typ : Entity_Id; + Valid_I : Interp_Index; - procedure Try_One_Interp (T1 : Entity_Id) is begin - if Has_Compatible_Type (R, T1, For_Comparison => True) then - if Found - and then Base_Type (T1) /= Base_Type (T_F) - then - It := Disambiguate (L, I_F, Index, Any_Type); + -- Defend against previous error - if It = No_Interp then - Ambiguous_Operands (N); - Set_Etype (L, Any_Type); - return; + if Nkind (R) = N_Error then + Found := False; - else - T_F := It.Typ; - end if; + -- Loop through the interpretations of the right operand - else - Found := True; - T_F := T1; - I_F := Index; - end if; + elsif not Is_Overloaded (R) then + Found := Is_Valid_Pair (T, Etype (R)); + + else + Found := False; + R_Typ := Empty; + Valid_I := 0; - Set_Etype (L, T_F); + Get_First_Interp (R, I, It); + while Present (It.Typ) loop + if Is_Valid_Pair (T, It.Typ) then + -- If several interpretations are possible, disambiguate + + if Present (R_Typ) + and then Base_Type (It.Typ) /= Base_Type (R_Typ) + then + It := Disambiguate (R, Valid_I, I, Any_Type); + + if It = No_Interp then + Ambiguous_Operands (N); + Set_Etype (R, Any_Type); + return True; + end if; + + else + Valid_I := I; + end if; + + R_Typ := It.Typ; + Found := True; + end if; + + Get_Next_Interp (I, It); + end loop; end if; - end Try_One_Interp; - Op : Node_Id; + return Found; + end Try_Left_Interp; + + ------------------- + -- Is_Valid_Pair -- + ------------------- + + function Is_Valid_Pair (T1, T2 : Entity_Id) return Boolean is + begin + return Covers (T1 => T1, T2 => T2) + or else Covers (T1 => T2, T2 => T1) + or else Is_User_Defined_Literal (L, T2) + or else Is_User_Defined_Literal (R, T1); + end Is_Valid_Pair; + + -- Local variables + + Dummy : Boolean; + Op : Node_Id; -- Start of processing for Analyze_Membership_Op @@ -3133,31 +3147,29 @@ package body Sem_Ch4 is if No (R) then pragma Assert (Ada_Version >= Ada_2012); + Analyze_Set_Membership; - Check_Function_Writable_Actuals (N); - return; - end if; - if Nkind (R) = N_Range + elsif Nkind (R) = N_Range or else (Nkind (R) = N_Attribute_Reference and then Attribute_Name (R) = Name_Range) then - Analyze (R); + Analyze_Expression (R); - Find_Interpretation; + Dummy := Find_Interp; -- If not a range, it can be a subtype mark, or else it is a degenerate -- membership test with a singleton value, i.e. a test for equality, -- if the types are compatible. else - Analyze (R); + Analyze_Expression (R); if Is_Entity_Name (R) and then Is_Type (Entity (R)) then Find_Type (R); Check_Fully_Declared (Entity (R), R); - elsif Ada_Version >= Ada_2012 and then Find_Interpretation then + elsif Ada_Version >= Ada_2012 and then Find_Interp then if Nkind (N) = N_In then Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R); else @@ -3616,8 +3628,8 @@ package body Sem_Ch4 is return; end if; - -- This can occur when the prefix of the call is an operator - -- name or an expanded name whose selector is an operator name. + -- This occurs when the prefix of the call is an operator name + -- or an expanded name whose selector is an operator name. Analyze_Operator_Call (N, Nam); @@ -3933,17 +3945,14 @@ package body Sem_Ch4 is => Find_Boolean_Types (Act1, Act2, Op_Id, N); - when Name_Op_Ge + when Name_Op_Eq + | Name_Op_Ge | Name_Op_Gt | Name_Op_Le | Name_Op_Lt - => - Find_Comparison_Types (Act1, Act2, Op_Id, N); - - when Name_Op_Eq | Name_Op_Ne => - Find_Equality_Types (Act1, Act2, Op_Id, N); + Find_Comparison_Equality_Types (Act1, Act2, Op_Id, N); when Name_Op_Concat => Find_Concatenation_Types (Act1, Act2, Op_Id, N); @@ -5927,7 +5936,7 @@ package body Sem_Ch4 is then Add_One_Interp (N, Op_Id, Etype (Op_Id)); - -- If the left operand is overloaded, indicate that the current + -- If the operands are overloaded, indicate that the current -- type is a viable candidate. This is redundant in most cases, -- but for equality and comparison operators where the context -- does not impose a type on the operands, setting the proper @@ -5939,6 +5948,10 @@ package body Sem_Ch4 is Set_Etype (Left_Opnd (N), Etype (F1)); end if; + if Is_Overloaded (Right_Opnd (N)) then + Set_Etype (Right_Opnd (N), Etype (F2)); + end if; + if Debug_Flag_E then Write_Str ("user defined operator "); Write_Name (Chars (Op_Id)); @@ -6005,9 +6018,6 @@ package body Sem_Ch4 is -- Standard, the predefined universal fixed operator is available, -- as specified by AI-420 (RM 4.5.5 (19.1/2)). - function Specific_Type (T1, T2 : Entity_Id) return Entity_Id; - -- Get specific type (i.e. non-universal type if there is one) - ------------------ -- Has_Fixed_Op -- ------------------ @@ -6064,19 +6074,6 @@ package body Sem_Ch4 is return False; end Has_Fixed_Op; - ------------------- - -- Specific_Type -- - ------------------- - - function Specific_Type (T1, T2 : Entity_Id) return Entity_Id is - begin - if Is_Universal_Numeric_Type (T1) then - return Base_Type (T2); - else - return Base_Type (T1); - end if; - end Specific_Type; - -- Start of processing for Check_Arithmetic_Pair begin @@ -6246,18 +6243,6 @@ package body Sem_Ch4 is end if; end Check_Misspelled_Selector; - ---------------------- - -- Defined_In_Scope -- - ---------------------- - - function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean - is - S1 : constant Entity_Id := Scope (Base_Type (T)); - begin - return S1 = S - or else (S1 = System_Aux_Id and then S = Scope (S1)); - end Defined_In_Scope; - ------------------- -- Diagnose_Call -- ------------------- @@ -6268,32 +6253,35 @@ package body Sem_Ch4 is It : Interp; Err_Mode : Boolean; New_Nam : Node_Id; + Num_Actuals : Natural; + Num_Interps : Natural; Void_Interp_Seen : Boolean := False; Success : Boolean; pragma Warnings (Off, Boolean); begin - if Ada_Version >= Ada_2005 then - Actual := First_Actual (N); - while Present (Actual) loop + Num_Actuals := 0; + Actual := First_Actual (N); - -- Ada 2005 (AI-50217): Post an error in case of premature - -- usage of an entity from the limited view. + while Present (Actual) loop + -- Ada 2005 (AI-50217): Post an error in case of premature + -- usage of an entity from the limited view. - if not Analyzed (Etype (Actual)) - and then From_Limited_With (Etype (Actual)) - then - Error_Msg_Qual_Level := 1; - Error_Msg_NE - ("missing with_clause for scope of imported type&", - Actual, Etype (Actual)); - Error_Msg_Qual_Level := 0; - end if; + if not Analyzed (Etype (Actual)) + and then From_Limited_With (Etype (Actual)) + and then Ada_Version >= Ada_2005 + then + Error_Msg_Qual_Level := 1; + Error_Msg_NE + ("missing with_clause for scope of imported type&", + Actual, Etype (Actual)); + Error_Msg_Qual_Level := 0; + end if; - Next_Actual (Actual); - end loop; - end if; + Num_Actuals := Num_Actuals + 1; + Next_Actual (Actual); + end loop; -- Before listing the possible candidates, check whether this is -- a prefix of a selected component that has been rewritten as a @@ -6328,17 +6316,9 @@ package body Sem_Ch4 is end; end if; - -- Analyze each candidate call again, with full error reporting for - -- each. - - Error_Msg_N - ("no candidate interpretations match the actuals:!", Nam); - Err_Mode := All_Errors_Mode; - All_Errors_Mode := True; - - -- If this is a call to an operation of a concurrent type, - -- the failed interpretations have been removed from the - -- name. Recover them to provide full diagnostics. + -- If this is a call to an operation of a concurrent type, the failed + -- interpretations have been removed from the name. Recover them now + -- in order to provide full diagnostics. if Nkind (Parent (Nam)) = N_Selected_Component then Set_Entity (Nam, Empty); @@ -6352,6 +6332,48 @@ package body Sem_Ch4 is Get_First_Interp (Nam, X, It); end if; + -- If the number of actuals is 2, then remove interpretations involving + -- a unary "+" operator as they might yield confusing errors downstream. + + if Num_Actuals = 2 + and then Nkind (Parent (Nam)) /= N_Selected_Component + then + Num_Interps := 0; + + while Present (It.Nam) loop + if Ekind (It.Nam) = E_Operator + and then Chars (It.Nam) = Name_Op_Add + and then (No (First_Formal (It.Nam)) + or else No (Next_Formal (First_Formal (It.Nam)))) + then + Remove_Interp (X); + else + Num_Interps := Num_Interps + 1; + end if; + + Get_Next_Interp (X, It); + end loop; + + if Num_Interps = 0 then + Error_Msg_N ("!too many arguments in call to&", Nam); + return; + end if; + + Get_First_Interp (Nam, X, It); + + else + Num_Interps := 2; -- at least + end if; + + -- Analyze each candidate call again with full error reporting for each + + if Num_Interps > 1 then + Error_Msg_N ("!no candidate interpretations match the actuals:", Nam); + end if; + + Err_Mode := All_Errors_Mode; + All_Errors_Mode := True; + while Present (It.Nam) loop if Etype (It.Nam) = Standard_Void_Type then Void_Interp_Seen := True; @@ -6443,7 +6465,8 @@ package body Sem_Ch4 is procedure Check_Right_Argument (T : Entity_Id) is begin if not Is_Overloaded (R) then - Check_Arithmetic_Pair (T, Etype (R), Op_Id, N); + Check_Arithmetic_Pair (T, Etype (R), Op_Id, N); + else Get_First_Interp (R, Index2, It2); while Present (It2.Typ) loop @@ -6466,7 +6489,6 @@ package body Sem_Ch4 is Get_Next_Interp (Index1, It1); end loop; end if; - end Find_Arithmetic_Types; ------------------------ @@ -6562,652 +6584,334 @@ package body Sem_Ch4 is end if; end Find_Boolean_Types; - --------------------------- - -- Find_Comparison_Types -- - --------------------------- + ------------------------------------ + -- Find_Comparison_Equality_Types -- + ------------------------------------ + + -- The context of the operator plays no role in resolving the operands, + -- so that if there is more than one interpretation of the operands that + -- is compatible with the comparison or equality, then the operation is + -- ambiguous, but this cannot be reported at this point because there is + -- no guarantee that the operation will be resolved to this operator yet. - procedure Find_Comparison_Types + procedure Find_Comparison_Equality_Types (L, R : Node_Id; Op_Id : Entity_Id; N : Node_Id) is - Index : Interp_Index; - It : Interp; - Found : Boolean := False; - I_F : Interp_Index; - T_F : Entity_Id; - Scop : Entity_Id := Empty; - - procedure Try_One_Interp (T1 : Entity_Id); - -- Routine to try one proposed interpretation. Note that the context - -- of the operator plays no role in resolving the arguments, so that - -- if there is more than one interpretation of the operands that is - -- compatible with comparison, the operation is ambiguous. - - -------------------- - -- Try_One_Interp -- - -------------------- - - procedure Try_One_Interp (T1 : Entity_Id) is - begin - -- If the operator is an expanded name, then the type of the operand - -- must be defined in the corresponding scope. If the type is - -- universal, the context will impose the correct type. Note that we - -- also avoid returning if we are currently within a generic instance - -- due to the fact that the generic package declaration has already - -- been successfully analyzed and Defined_In_Scope expects the base - -- type to be defined within the instance which will never be the - -- case. - - if Present (Scop) - and then not Defined_In_Scope (T1, Scop) - and then not In_Instance - and then T1 /= Universal_Integer - and then T1 /= Universal_Real - and then T1 /= Any_String - and then T1 /= Any_Composite - then - return; - end if; - - if Valid_Comparison_Arg (T1) - and then Has_Compatible_Type (R, T1, For_Comparison => True) - then - if Found and then Base_Type (T1) /= Base_Type (T_F) then - It := Disambiguate (L, I_F, Index, Any_Type); + Op_Name : constant Name_Id := Chars (Op_Id); + Op_Typ : Entity_Id renames Standard_Boolean; - if It = No_Interp then - Ambiguous_Operands (N); - Set_Etype (L, Any_Type); - return; + function Try_Left_Interp (T : Entity_Id) return Entity_Id; + -- Try an interpretation of the left operand with type T. Return the + -- type of the interpretation of the right operand making up a valid + -- operand pair, or else Any_Type if the right operand is ambiguous, + -- otherwise Empty if no such pair exists. - else - T_F := It.Typ; - end if; - else - Found := True; - T_F := T1; - I_F := Index; - end if; + function Is_Valid_Comparison_Type (T : Entity_Id) return Boolean; + -- Return true if T is a valid comparison type - Set_Etype (L, T_F); - Find_Non_Universal_Interpretations (N, R, Op_Id, T1); - end if; - end Try_One_Interp; + function Is_Valid_Equality_Type + (T : Entity_Id; + Anon_Access : Boolean) return Boolean; + -- Return true if T is a valid equality type - -- Start of processing for Find_Comparison_Types + function Is_Valid_Pair (T1, T2 : Entity_Id) return Boolean; + -- Return true if T1 and T2 constitute a valid pair of operand types for + -- L and R respectively. - begin - -- If left operand is aggregate, the right operand has to - -- provide a usable type for it. + --------------------- + -- Try_Left_Interp -- + --------------------- - if Nkind (L) = N_Aggregate and then Nkind (R) /= N_Aggregate then - Find_Comparison_Types (L => R, R => L, Op_Id => Op_Id, N => N); - return; - end if; + function Try_Left_Interp (T : Entity_Id) return Entity_Id is + I : Interp_Index; + It : Interp; + R_Typ : Entity_Id; + Valid_I : Interp_Index; - if Nkind (N) = N_Function_Call - and then Nkind (Name (N)) = N_Expanded_Name - then - Scop := Entity (Prefix (Name (N))); + begin + -- Defend against previous error - -- The prefix may be a package renaming, and the subsequent test - -- requires the original package. + if Nkind (R) = N_Error then + null; - if Ekind (Scop) = E_Package - and then Present (Renamed_Entity (Scop)) - then - Scop := Renamed_Entity (Scop); - Set_Entity (Prefix (Name (N)), Scop); - end if; - end if; + -- Loop through the interpretations of the right operand - if not Is_Overloaded (L) then - Try_One_Interp (Etype (L)); + elsif not Is_Overloaded (R) then + if Is_Valid_Pair (T, Etype (R)) then + return Etype (R); + end if; - else - Get_First_Interp (L, Index, It); - while Present (It.Typ) loop - Try_One_Interp (It.Typ); - Get_Next_Interp (Index, It); - end loop; - end if; - end Find_Comparison_Types; + else + R_Typ := Empty; + Valid_I := 0; - ---------------------------------------- - -- Find_Non_Universal_Interpretations -- - ---------------------------------------- + Get_First_Interp (R, I, It); + while Present (It.Typ) loop + if Is_Valid_Pair (T, It.Typ) then + -- If several interpretations are possible, disambiguate - procedure Find_Non_Universal_Interpretations - (N : Node_Id; - R : Node_Id; - Op_Id : Entity_Id; - T1 : Entity_Id) - is - Index : Interp_Index; - It : Interp; + if Present (R_Typ) + and then Base_Type (It.Typ) /= Base_Type (R_Typ) + then + It := Disambiguate (R, Valid_I, I, Any_Type); - begin - -- Defend against previous error + if It = No_Interp then + R_Typ := Any_Type; + exit; + end if; - if Nkind (R) = N_Error then - return; - end if; + else + Valid_I := I; + end if; - if T1 = Universal_Integer - or else T1 = Universal_Real - or else T1 = Universal_Access - then - if not Is_Overloaded (R) then - Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (Etype (R))); - else - Get_First_Interp (R, Index, It); - while Present (It.Typ) loop - if Covers (It.Typ, T1) then - Add_One_Interp - (N, Op_Id, Standard_Boolean, Base_Type (It.Typ)); + R_Typ := It.Typ; end if; - Get_Next_Interp (Index, It); + Get_Next_Interp (I, It); end loop; - end if; - - elsif Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then - Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (T1)); - end if; - end Find_Non_Universal_Interpretations; - - ------------------------------ - -- Find_Concatenation_Types -- - ------------------------------ - - procedure Find_Concatenation_Types - (L, R : Node_Id; - Op_Id : Entity_Id; - N : Node_Id) - is - Is_String : constant Boolean := Nkind (L) = N_String_Literal - or else - Nkind (R) = N_String_Literal; - Op_Type : constant Entity_Id := Etype (Op_Id); - - begin - if Is_Array_Type (Op_Type) - -- Small but very effective optimization: if at least one operand is a - -- string literal, then the type of the operator must be either array - -- of characters or array of strings. - - and then (not Is_String - or else - Is_Character_Type (Component_Type (Op_Type)) - or else - Is_String_Type (Component_Type (Op_Type))) - - and then not Is_Limited_Type (Op_Type) - - and then (Has_Compatible_Type (L, Op_Type) - or else - Has_Compatible_Type (L, Component_Type (Op_Type))) - - and then (Has_Compatible_Type (R, Op_Type) - or else - Has_Compatible_Type (R, Component_Type (Op_Type))) - then - Add_One_Interp (N, Op_Id, Op_Type); - end if; - end Find_Concatenation_Types; - - ------------------------- - -- Find_Equality_Types -- - ------------------------- - - procedure Find_Equality_Types - (L, R : Node_Id; - Op_Id : Entity_Id; - N : Node_Id) - is - Index : Interp_Index := 0; - It : Interp; - Found : Boolean := False; - Is_Universal_Access : Boolean := False; - I_F : Interp_Index; - T_F : Entity_Id; - Scop : Entity_Id := Empty; - - procedure Check_Access_Attribute (N : Node_Id); - -- For any object, '[Unchecked_]Access of such object can never be - -- passed as a parameter of a call to the Universal_Access equality - -- operator. - -- This is because the expected type for Obj'Access in a call to - -- the Standard."=" operator whose formals are of type - -- Universal_Access is Universal_Access, and Universal_Access - -- doesn't have a designated type. For more detail see RM 6.4.1(3) - -- and 3.10.2. - -- This procedure assumes that the context is a universal_access. - - function Check_Access_Object_Types - (N : Node_Id; Typ : Entity_Id) return Boolean; - -- Check for RM 4.5.2 (9.6/2): When both are of access-to-object types, - -- the designated types shall be the same or one shall cover the other, - -- and if the designated types are elementary or array types, then the - -- designated subtypes shall statically match. - -- If N is not overloaded, then its unique type must be compatible as - -- per above. Otherwise iterate through the interpretations of N looking - -- for a compatible one. - - procedure Check_Compatible_Profiles (N : Node_Id; Typ : Entity_Id); - -- Check for RM 4.5.2(9.7/2): When both are of access-to-subprogram - -- types, the designated profiles shall be subtype conformant. - - function References_Anonymous_Access_Type - (N : Node_Id; Typ : Entity_Id) return Boolean; - -- Return True either if N is not overloaded and its Etype is an - -- anonymous access type or if one of the interpretations of N refers - -- to an anonymous access type compatible with Typ. - - procedure Try_One_Interp (T1 : Entity_Id); - -- The context of the equality operator plays no role in resolving the - -- arguments, so that if there is more than one interpretation of the - -- operands that is compatible with equality, the construct is ambiguous - -- and an error can be emitted now, after trying to disambiguate, i.e. - -- applying preference rules. - - ---------------------------- - -- Check_Access_Attribute -- - ---------------------------- - - procedure Check_Access_Attribute (N : Node_Id) is - begin - if Nkind (N) = N_Attribute_Reference - and then Attribute_Name (N) in Name_Access | Name_Unchecked_Access - then - Error_Msg_N - ("access attribute cannot be used as actual for " - & "universal_access equality", N); + if Present (R_Typ) then + return R_Typ; + end if; end if; - end Check_Access_Attribute; - - ------------------------------- - -- Check_Access_Object_Types -- - ------------------------------- - - function Check_Access_Object_Types - (N : Node_Id; Typ : Entity_Id) return Boolean - is - function Check_Designated_Types (DT1, DT2 : Entity_Id) return Boolean; - -- Check RM 4.5.2 (9.6/2) on the given designated types. - - ---------------------------- - -- Check_Designated_Types -- - ---------------------------- - - function Check_Designated_Types - (DT1, DT2 : Entity_Id) return Boolean is - begin - -- If the designated types are elementary or array types, then - -- the designated subtypes shall statically match. - - if Is_Elementary_Type (DT1) or else Is_Array_Type (DT1) then - if Base_Type (DT1) /= Base_Type (DT2) then - return False; - else - return Subtypes_Statically_Match (DT1, DT2); - end if; - - -- Otherwise, the designated types shall be the same or one - -- shall cover the other. - else - return DT1 = DT2 - or else Covers (DT1, DT2) - or else Covers (DT2, DT1); - end if; - end Check_Designated_Types; + return Empty; + end Try_Left_Interp; - -- Start of processing for Check_Access_Object_Types + ------------------------------ + -- Is_Valid_Comparison_Type -- + ------------------------------ + function Is_Valid_Comparison_Type (T : Entity_Id) return Boolean is begin - -- Return immediately with no checks if Typ is not an - -- access-to-object type. - - if not Is_Access_Object_Type (Typ) then - return True; + -- The operation must be performed in a context where the operators + -- of the base type are visible. - -- Any_Type is compatible with all types in this context, and is used - -- in particular for the designated type of a 'null' value. + if Is_Visible_Operator (N, Base_Type (T)) then + null; - elsif Directly_Designated_Type (Typ) = Any_Type - or else Nkind (N) = N_Null - then - return True; - end if; + -- Save candidate type for subsequent error message, if any - if not Is_Overloaded (N) then - if Is_Access_Object_Type (Etype (N)) then - return Check_Designated_Types - (Designated_Type (Typ), Designated_Type (Etype (N))); - end if; else - declare - Typ_Is_Anonymous : constant Boolean := - Is_Anonymous_Access_Type (Typ); - - I : Interp_Index; - It : Interp; - - begin - Get_First_Interp (N, I, It); - while Present (It.Typ) loop - - -- The check on designated types if only relevant when one - -- of the types is anonymous, ignore other (non relevant) - -- types. - - if (Typ_Is_Anonymous - or else Is_Anonymous_Access_Type (It.Typ)) - and then Is_Access_Object_Type (It.Typ) - then - if Check_Designated_Types - (Designated_Type (Typ), Designated_Type (It.Typ)) - then - return True; - end if; - end if; + if Valid_Comparison_Arg (T) then + Candidate_Type := T; + end if; - Get_Next_Interp (I, It); - end loop; - end; + return False; end if; - return False; - end Check_Access_Object_Types; + -- Defer to the common implementation for the rest - ------------------------------- - -- Check_Compatible_Profiles -- - ------------------------------- + return Valid_Comparison_Arg (T); + end Is_Valid_Comparison_Type; - procedure Check_Compatible_Profiles (N : Node_Id; Typ : Entity_Id) is - I : Interp_Index; - It : Interp; - I1 : Interp_Index := 0; - Found : Boolean := False; - Tmp : Entity_Id := Empty; + ---------------------------- + -- Is_Valid_Equality_Type -- + ---------------------------- + function Is_Valid_Equality_Type + (T : Entity_Id; + Anon_Access : Boolean) return Boolean + is begin - if not Is_Overloaded (N) then - Check_Subtype_Conformant - (Designated_Type (Etype (N)), Designated_Type (Typ), N); - else - Get_First_Interp (N, I, It); - while Present (It.Typ) loop - if Is_Access_Subprogram_Type (It.Typ) then - if not Found then - Found := True; - Tmp := It.Typ; - I1 := I; + -- The operation must be performed in a context where the operators + -- of the base type are visible. Deal with special types used with + -- access types before type resolution is done. - else - It := Disambiguate (N, I1, I, Any_Type); - - if It /= No_Interp then - Tmp := It.Typ; - I1 := I; - else - Found := False; - exit; - end if; - end if; - end if; + if Ekind (T) = E_Access_Attribute_Type + or else (Ekind (T) in E_Access_Subprogram_Type + | E_Access_Protected_Subprogram_Type + and then + Ekind (Designated_Type (T)) /= E_Subprogram_Type) + or else Is_Visible_Operator (N, Base_Type (T)) + then + null; - Get_Next_Interp (I, It); - end loop; + -- AI95-0230: Keep restriction imposed by Ada 83 and 95, do not allow + -- anonymous access types in universal_access equality operators. - if Found then - Check_Subtype_Conformant - (Designated_Type (Tmp), Designated_Type (Typ), N); + elsif Anon_Access then + if Ada_Version < Ada_2005 then + return False; end if; - end if; - end Check_Compatible_Profiles; - -------------------------------------- - -- References_Anonymous_Access_Type -- - -------------------------------------- + -- Save candidate type for subsequent error message, if any - function References_Anonymous_Access_Type - (N : Node_Id; Typ : Entity_Id) return Boolean - is - I : Interp_Index; - It : Interp; - begin - if not Is_Overloaded (N) then - return Is_Anonymous_Access_Type (Etype (N)); else - Get_First_Interp (N, I, It); - while Present (It.Typ) loop - if Is_Anonymous_Access_Type (It.Typ) - and then (Covers (It.Typ, Typ) or else Covers (Typ, It.Typ)) - then - return True; - end if; - - Get_Next_Interp (I, It); - end loop; + if Valid_Equality_Arg (T) then + Candidate_Type := T; + end if; return False; end if; - end References_Anonymous_Access_Type; - -------------------- - -- Try_One_Interp -- - -------------------- - - procedure Try_One_Interp (T1 : Entity_Id) is - Anonymous_Access : Boolean; - Bas : Entity_Id; + -- For the use of a "/=" operator on a tagged type, several possible + -- interpretations of equality need to be considered, we don't want + -- the default inequality declared in Standard to be chosen, and the + -- "/=" operator will be rewritten as a negation of "=" (see the end + -- of Analyze_Comparison_Equality_Op). This ensures the rewriting + -- occurs during analysis rather than being delayed until expansion. + -- Note that, if the node is N_Op_Ne but Op_Id is Name_Op_Eq, then we + -- still proceed with the interpretation, because this indicates + -- the aforementioned rewriting case where the interpretation to be + -- considered is actually that of the "=" operator. + + if Nkind (N) = N_Op_Ne + and then Op_Name /= Name_Op_Eq + and then Is_Tagged_Type (T) + then + return False; - begin - -- Perform a sanity check in case of previous errors + -- Defer to the common implementation for the rest - if No (T1) then - return; + else + return Valid_Equality_Arg (T); end if; + end Is_Valid_Equality_Type; - Bas := Base_Type (T1); - - -- If the operator is an expanded name, then the type of the operand - -- must be defined in the corresponding scope. If the type is - -- universal, the context will impose the correct type. An anonymous - -- type for a 'Access reference is also universal in this sense, as - -- the actual type is obtained from context. - - -- In Ada 2005, the equality operator for anonymous access types - -- is declared in Standard, and preference rules apply to it. - - Anonymous_Access := Is_Anonymous_Access_Type (T1) - or else References_Anonymous_Access_Type (R, T1); + ------------------- + -- Is_Valid_Pair -- + ------------------- - if Present (Scop) then + function Is_Valid_Pair (T1, T2 : Entity_Id) return Boolean is + begin + if Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne then + declare + Anon_Access : constant Boolean := + Is_Anonymous_Access_Type (T1) + or else Is_Anonymous_Access_Type (T2); + -- RM 4.5.2(9.1/2): At least one of the operands of an equality + -- operator for universal_access shall be of specific anonymous + -- access type. - -- Note that we avoid returning if we are currently within a - -- generic instance due to the fact that the generic package - -- declaration has already been successfully analyzed and - -- Defined_In_Scope expects the base type to be defined within - -- the instance which will never be the case. + begin + if not Is_Valid_Equality_Type (T1, Anon_Access) + or else not Is_Valid_Equality_Type (T2, Anon_Access) + then + return False; + end if; + end; - if Defined_In_Scope (T1, Scop) - or else In_Instance - or else T1 = Universal_Integer - or else T1 = Universal_Real - or else T1 = Universal_Access - or else T1 = Any_String - or else T1 = Any_Composite - or else (Ekind (T1) = E_Access_Subprogram_Type - and then not Comes_From_Source (T1)) + else + if not Is_Valid_Comparison_Type (T1) + or else not Is_Valid_Comparison_Type (T2) then - null; - - elsif Scop /= Standard_Standard or else not Anonymous_Access then - - -- The scope does not contain an operator for the type - - return; + return False; end if; + end if; - -- If we have infix notation, the operator must be usable. Within - -- an instance, the type may have been immediately visible if the - -- types are compatible. + return Covers (T1 => T1, T2 => T2) + or else Covers (T1 => T2, T2 => T1) + or else Is_User_Defined_Literal (L, T2) + or else Is_User_Defined_Literal (R, T1); + end Is_Valid_Pair; - elsif In_Open_Scopes (Scope (Bas)) - or else Is_Potentially_Use_Visible (Bas) - or else In_Use (Bas) - or else (In_Use (Scope (Bas)) and then not Is_Hidden (Bas)) - or else - ((In_Instance or else In_Inlined_Body) - and then Has_Compatible_Type (R, T1)) - then - null; + -- Local variables - elsif not Anonymous_Access then - -- Save candidate type for subsequent error message, if any + I : Interp_Index; + It : Interp; + L_Typ : Entity_Id; + R_Typ : Entity_Id; + T : Entity_Id; + Valid_I : Interp_Index; - if not Is_Limited_Type (T1) then - Candidate_Type := T1; - end if; + -- Start of processing for Find_Comparison_Equality_Types - return; - end if; + begin + -- Loop through the interpretations of the left operand - -- Ada 2005 (AI-230): Keep restriction imposed by Ada 83 and 95: - -- Do not allow anonymous access types in equality operators. + if not Is_Overloaded (L) then + T := Try_Left_Interp (Etype (L)); - if Ada_Version < Ada_2005 and then Anonymous_Access then - return; + if Present (T) then + Set_Etype (R, T); + Add_One_Interp (N, Op_Id, Op_Typ, Find_Unique_Type (L, R)); end if; - -- If the right operand has a type compatible with T1, check for an - -- acceptable interpretation, unless T1 is limited (no predefined - -- equality available), or this is use of a "/=" for a tagged type. - -- In the latter case, possible interpretations of equality need - -- to be considered, we don't want the default inequality declared - -- in Standard to be chosen, and the "/=" will be rewritten as a - -- negation of "=" (see the end of Analyze_Equality_Op). This ensures - -- that rewriting happens during analysis rather than being - -- delayed until expansion (is this still needed now that ASIS mode - -- is gone???). Note that if the node is N_Op_Ne, but Op_Id - -- is Name_Op_Eq then we still proceed with the interpretation, - -- because that indicates the potential rewriting case where the - -- interpretation to consider is actually "=" and the node may be - -- about to be rewritten by Analyze_Equality_Op. - -- Finally, also check for RM 4.5.2 (9.6/2). - - if T1 /= Standard_Void_Type - and then (Anonymous_Access - or else - Has_Compatible_Type (R, T1, For_Comparison => True)) - - and then - ((not Is_Limited_Type (T1) - and then not Is_Limited_Composite (T1)) + else + L_Typ := Empty; + R_Typ := Empty; + Valid_I := 0; - or else - (Is_Array_Type (T1) - and then not Is_Limited_Type (Component_Type (T1)) - and then Available_Full_View_Of_Component (T1))) + Get_First_Interp (L, I, It); + while Present (It.Typ) loop + T := Try_Left_Interp (It.Typ); - and then - (Nkind (N) /= N_Op_Ne - or else not Is_Tagged_Type (T1) - or else Chars (Op_Id) = Name_Op_Eq) + if Present (T) then + -- If several interpretations are possible, disambiguate - and then (not Anonymous_Access - or else Check_Access_Object_Types (R, T1)) - then - if Found - and then Base_Type (T1) /= Base_Type (T_F) - then - It := Disambiguate (L, I_F, Index, Any_Type); + if Present (L_Typ) + and then Base_Type (It.Typ) /= Base_Type (L_Typ) + then + It := Disambiguate (L, Valid_I, I, Any_Type); - if It = No_Interp then - Ambiguous_Operands (N); - Set_Etype (L, Any_Type); - return; + if It = No_Interp then + L_Typ := Any_Type; + R_Typ := T; + exit; + end if; else - T_F := It.Typ; - Is_Universal_Access := Anonymous_Access; + Valid_I := I; end if; - else - Found := True; - T_F := T1; - I_F := Index; - Is_Universal_Access := Anonymous_Access; + L_Typ := It.Typ; + R_Typ := T; end if; - if not Analyzed (L) then - Set_Etype (L, T_F); - end if; - - Find_Non_Universal_Interpretations (N, R, Op_Id, T1); - - -- Case of operator was not visible, Etype still set to Any_Type + Get_Next_Interp (I, It); + end loop; - if Etype (N) = Any_Type then - Found := False; - end if; + if Present (L_Typ) then + Set_Etype (L, L_Typ); + Set_Etype (R, R_Typ); + Add_One_Interp (N, Op_Id, Op_Typ, Find_Unique_Type (L, R)); end if; - end Try_One_Interp; - - -- Start of processing for Find_Equality_Types + end if; + end Find_Comparison_Equality_Types; - begin - -- If left operand is aggregate, the right operand has to - -- provide a usable type for it. + ------------------------------ + -- Find_Concatenation_Types -- + ------------------------------ - if Nkind (L) = N_Aggregate and then Nkind (R) /= N_Aggregate then - Find_Equality_Types (L => R, R => L, Op_Id => Op_Id, N => N); - return; - end if; + procedure Find_Concatenation_Types + (L, R : Node_Id; + Op_Id : Entity_Id; + N : Node_Id) + is + Is_String : constant Boolean := Nkind (L) = N_String_Literal + or else + Nkind (R) = N_String_Literal; + Op_Type : constant Entity_Id := Etype (Op_Id); - if Nkind (N) = N_Function_Call - and then Nkind (Name (N)) = N_Expanded_Name - then - Scop := Entity (Prefix (Name (N))); + begin + if Is_Array_Type (Op_Type) - -- The prefix may be a package renaming, and the subsequent test - -- requires the original package. + -- Small but very effective optimization: if at least one operand is a + -- string literal, then the type of the operator must be either array + -- of characters or array of strings. - if Ekind (Scop) = E_Package - and then Present (Renamed_Entity (Scop)) - then - Scop := Renamed_Entity (Scop); - Set_Entity (Prefix (Name (N)), Scop); - end if; - end if; + and then (not Is_String + or else + Is_Character_Type (Component_Type (Op_Type)) + or else + Is_String_Type (Component_Type (Op_Type))) - if not Is_Overloaded (L) then - Try_One_Interp (Etype (L)); - else - Get_First_Interp (L, Index, It); - while Present (It.Typ) loop - Try_One_Interp (It.Typ); - Get_Next_Interp (Index, It); - end loop; - end if; + and then not Is_Limited_Type (Op_Type) - if Is_Universal_Access then - if Is_Access_Subprogram_Type (Etype (L)) - and then Nkind (L) /= N_Null - and then Nkind (R) /= N_Null - then - Check_Compatible_Profiles (R, Etype (L)); - end if; + and then (Has_Compatible_Type (L, Op_Type) + or else + Has_Compatible_Type (L, Component_Type (Op_Type))) - Check_Access_Attribute (R); - Check_Access_Attribute (L); + and then (Has_Compatible_Type (R, Op_Type) + or else + Has_Compatible_Type (R, Component_Type (Op_Type))) + then + Add_One_Interp (N, Op_Id, Op_Type); end if; - end Find_Equality_Types; + end Find_Concatenation_Types; ------------------------- -- Find_Negation_Types -- @@ -7556,7 +7260,9 @@ package body Sem_Ch4 is then return; - elsif Has_Possible_Literal_Aspects (N) then + elsif Present (Entity (N)) + and then Has_Possible_Literal_Aspects (N) + then return; -- If we have a logical operator, one of whose operands is @@ -7605,7 +7311,7 @@ package body Sem_Ch4 is Standard_Address, Relocate_Node (R))); if Nkind (N) in N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt then - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); else Analyze_Arithmetic_Op (N); end if; @@ -7627,7 +7333,7 @@ package body Sem_Ch4 is Standard_Address, Relocate_Node (R))); if Nkind (N) in N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt then - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); else Analyze_Arithmetic_Op (N); end if; @@ -7657,7 +7363,7 @@ package body Sem_Ch4 is Standard_Address, Relocate_Node (R))); if Nkind (N) in N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt then - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); else Analyze_Arithmetic_Op (N); end if; @@ -7681,7 +7387,7 @@ package body Sem_Ch4 is Replace_Null_By_Null_Address (N); if Nkind (N) in N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt then - Analyze_Comparison_Op (N); + Analyze_Comparison_Equality_Op (N); else Analyze_Arithmetic_Op (N); end if; @@ -7758,7 +7464,7 @@ package body Sem_Ch4 is Rewrite (R, Unchecked_Convert_To ( Standard_Address, Relocate_Node (R))); - Analyze_Equality_Op (N); + Analyze_Comparison_Equality_Op (N); return; -- Under relaxed RM semantics silently replace occurrences of @@ -7766,7 +7472,7 @@ package body Sem_Ch4 is elsif Null_To_Null_Address_Convert_OK (N) then Replace_Null_By_Null_Address (N); - Analyze_Equality_Op (N); + Analyze_Comparison_Equality_Op (N); return; end if; end if; diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 9253180..870edea 100644 --- a/gcc/ada/sem_ch4.ads +++ b/gcc/ada/sem_ch4.ads @@ -31,9 +31,8 @@ package Sem_Ch4 is procedure Analyze_Arithmetic_Op (N : Node_Id); procedure Analyze_Call (N : Node_Id); procedure Analyze_Case_Expression (N : Node_Id); - procedure Analyze_Comparison_Op (N : Node_Id); + procedure Analyze_Comparison_Equality_Op (N : Node_Id); procedure Analyze_Concatenation (N : Node_Id); - procedure Analyze_Equality_Op (N : Node_Id); procedure Analyze_Explicit_Dereference (N : Node_Id); procedure Analyze_Expression_With_Actions (N : Node_Id); procedure Analyze_If_Expression (N : Node_Id); @@ -54,6 +53,10 @@ package Sem_Ch4 is procedure Analyze_Unchecked_Expression (N : Node_Id); procedure Analyze_Unchecked_Type_Conversion (N : Node_Id); + procedure Ambiguous_Operands (N : Node_Id); + -- Give an error for comparison, equality and membership operators with + -- ambiguous operands, and list possible interpretations. + procedure Analyze_Indexed_Component_Form (N : Node_Id); -- Prior to semantic analysis, an indexed component node can denote any -- of the following syntactic constructs: diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a672ea8..22faeb6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4931,9 +4931,7 @@ package body Sem_Ch6 is -- by the GCC backend (ie. "function might not be -- inlinable"). - if Present (Subp_Decl) - and then Has_Excluded_Declaration (Spec_Id, Subp_Decl) - then + if Has_Excluded_Declaration (Spec_Id, Subp_Decl) then null; elsif Has_Excluded_Statement diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index e575602..786df01 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -474,6 +474,10 @@ package body Sem_Ch8 is -- scope: the defining entity for U, unless U is a package instance, in -- which case we retrieve the entity of the instance spec. + procedure Error_Missing_With_Of_Known_Unit (Pkg : Node_Id); + -- Display an error message denoting a "with" is missing for a given known + -- package Pkg with its full path name. + procedure Find_Expanded_Name (N : Node_Id); -- The input is a selected component known to be an expanded name. Verify -- legality of selector given the scope denoted by prefix, and change node @@ -509,6 +513,7 @@ package body Sem_Ch8 is function Has_Implicit_Operator (N : Node_Id) return Boolean; -- N is an expanded name whose selector is an operator name (e.g. P."+"). + -- Determine if N denotes an operator implicitly declared in prefix P: P's -- declarative part contains an implicit declaration of an operator if it -- has a declaration of a type to which one of the predefined operators -- apply. The existence of this routine is an implementation artifact. A @@ -4532,7 +4537,7 @@ package body Sem_Ch8 is -- have at least one formal parameter, with the exceptions of the GNAT -- attribute 'Img, which GNAT treats as renameable. - if not Is_Non_Empty_List (Parameter_Specifications (Spec)) then + if Is_Empty_List (Parameter_Specifications (Spec)) then if Aname /= Name_Img then Error_Msg_N ("subprogram renaming an attribute must have formals", N); @@ -5333,6 +5338,81 @@ package body Sem_Ch8 is end if; end Entity_Of_Unit; + -------------------------------------- + -- Error_Missing_With_Of_Known_Unit -- + -------------------------------------- + + procedure Error_Missing_With_Of_Known_Unit (Pkg : Node_Id) is + Selectors : array (1 .. 6) of Node_Id; + -- Contains the chars of the full package name up to maximum number + -- allowed as per Errout.Error_Msg_Name_# variables. + + Count : Integer := Selectors'First; + -- Count of selector names forming the full package name + + Current_Pkg : Node_Id := Parent (Pkg); + + begin + Selectors (Count) := Pkg; + + -- Gather all the selectors we can display + + while Nkind (Current_Pkg) = N_Selected_Component + and then Is_Known_Unit (Current_Pkg) + and then Count < Selectors'Length + loop + Count := Count + 1; + Selectors (Count) := Selector_Name (Current_Pkg); + Current_Pkg := Parent (Current_Pkg); + end loop; + + -- Display the error message based on the number of selectors found + + case Count is + when 1 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &;`", Pkg); + when 2 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&;`", Pkg); + when 3 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&;`", Pkg); + when 4 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_3 := Selectors (4); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&;`", Pkg); + when 5 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_3 := Selectors (4); + Error_Msg_Node_3 := Selectors (5); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&.&;`", Pkg); + when 6 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_4 := Selectors (4); + Error_Msg_Node_5 := Selectors (5); + Error_Msg_Node_6 := Selectors (6); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&.&.&;`", Pkg); + when others => + raise Program_Error; + end case; + end Error_Missing_With_Of_Known_Unit; + ---------------------- -- Find_Direct_Name -- ---------------------- @@ -5876,25 +5956,7 @@ package body Sem_Ch8 is and then N = Prefix (Parent (N)) and then Is_Known_Unit (Parent (N)) then - declare - P : Node_Id := Parent (N); - begin - Error_Msg_Name_1 := Chars (N); - Error_Msg_Name_2 := Chars (Selector_Name (P)); - - if Nkind (Parent (P)) = N_Selected_Component - and then Is_Known_Unit (Parent (P)) - then - P := Parent (P); - Error_Msg_Name_3 := Chars (Selector_Name (P)); - Error_Msg_N -- CODEFIX - ("\\missing `WITH %.%.%;`", N); - - else - Error_Msg_N -- CODEFIX - ("\\missing `WITH %.%;`", N); - end if; - end; + Error_Missing_With_Of_Known_Unit (N); end if; -- Now check for possible misspellings @@ -6909,9 +6971,7 @@ package body Sem_Ch8 is Standard_Standard) then if not Error_Posted (N) then - Error_Msg_Node_2 := Selector; - Error_Msg_N -- CODEFIX - ("missing `WITH &.&;`", Prefix (N)); + Error_Missing_With_Of_Known_Unit (Prefix (N)); end if; -- If this is a selection from a dummy package, then suppress @@ -8650,7 +8710,10 @@ package body Sem_Ch8 is | Name_Op_Xor => while Id /= Priv_Id loop - if Valid_Boolean_Arg (Id) and then Is_Base_Type (Id) then + if Is_Type (Id) + and then Valid_Boolean_Arg (Id) + and then Is_Base_Type (Id) + then Add_Implicit_Operator (Id); return True; end if; @@ -8665,7 +8728,7 @@ package body Sem_Ch8 is => while Id /= Priv_Id loop if Is_Type (Id) - and then not Is_Limited_Type (Id) + and then Valid_Equality_Arg (Id) and then Is_Base_Type (Id) then Add_Implicit_Operator (Standard_Boolean, Id); @@ -8683,9 +8746,8 @@ package body Sem_Ch8 is | Name_Op_Lt => while Id /= Priv_Id loop - if (Is_Scalar_Type (Id) - or else (Is_Array_Type (Id) - and then Is_Scalar_Type (Component_Type (Id)))) + if Is_Type (Id) + and then Valid_Comparison_Arg (Id) and then Is_Base_Type (Id) then Add_Implicit_Operator (Standard_Boolean, Id); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f9169ee..9ef3a06 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5168,12 +5168,12 @@ package body Sem_Prag is elsif Has_Pragma_Unmodified (Arg_Id) then if Has_Pragma_Unused (Arg_Id) then Error_Msg_NE - ("??pragma Unused already given for &!", Arg_Expr, - Arg_Id); + (Fix_Error ("??pragma Unused already given for &!"), + Arg_Expr, Arg_Id); else Error_Msg_NE - ("??pragma Unmodified already given for &!", Arg_Expr, - Arg_Id); + (Fix_Error ("??pragma Unmodified already given for &!"), + Arg_Expr, Arg_Id); end if; -- Otherwise the pragma referenced an illegal entity @@ -5276,12 +5276,13 @@ package body Sem_Prag is if Has_Pragma_Unreferenced (Arg_Id) then if Has_Pragma_Unused (Arg_Id) then Error_Msg_NE - ("??pragma Unused already given for &!", Arg_Expr, - Arg_Id); + (Fix_Error ("??pragma Unused already given for &!"), + Arg_Expr, Arg_Id); else Error_Msg_NE - ("??pragma Unreferenced already given for &!", - Arg_Expr, Arg_Id); + (Fix_Error + ("??pragma Unreferenced already given for &!"), + Arg_Expr, Arg_Id); end if; -- Apply Unreferenced to the entity @@ -19454,8 +19455,39 @@ package body Sem_Prag is end; end if; - Preanalyze_Assert_Expression - (Expression (Variant), Any_Discrete); + -- Preanalyze_Assert_Expression, but without enforcing any of + -- the two acceptable types. + + Preanalyze_Assert_Expression (Expression (Variant)); + + -- Expression of a discrete type is allowed + + if Is_Discrete_Type (Etype (Expression (Variant))) then + null; + + -- Expression of a Big_Integer type (or its ghost variant) is + -- only allowed in Decreases clause. + + elsif + Is_RTE (Base_Type (Etype (Expression (Variant))), + RE_Big_Integer) + or else + Is_RTE (Base_Type (Etype (Expression (Variant))), + RO_GH_Big_Integer) + then + if Chars (Variant) = Name_Increases then + Error_Msg_N + ("Loop_Variant with Big_Integer can only decrease", + Expression (Variant)); + end if; + + -- Expression of other types is not allowed + + else + Error_Msg_N + ("expected a discrete or Big_Integer type", + Expression (Variant)); + end if; Next (Variant); end loop; @@ -29414,7 +29446,36 @@ package body Sem_Prag is end if; Errors := Serious_Errors_Detected; - Preanalyze_Assert_Expression (Expr, Any_Discrete); + + -- Preanalyze_Assert_Expression, but without enforcing any of the two + -- acceptable types. + + Preanalyze_Assert_Expression (Expr); + + -- Expression of a discrete type is allowed + + if Is_Discrete_Type (Etype (Expr)) then + null; + + -- Expression of a Big_Integer type (or its ghost variant) is only + -- allowed in Decreases clause. + + elsif + Is_RTE (Base_Type (Etype (Expr)), RE_Big_Integer) + or else + Is_RTE (Base_Type (Etype (Expr)), RO_GH_Big_Integer) + then + if Chars (Direction) = Name_Increases then + Error_Msg_N + ("Subprogram_Variant with Big_Integer can only decrease", + Expr); + end if; + + -- Expression of other types is not allowed + + else + Error_Msg_N ("expected a discrete or Big_Integer type", Expr); + end if; -- Emit a clarification message when the variant expression -- contains at least one undefined reference, possibly due diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4f66b71..1c686cd 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -141,7 +141,7 @@ package body Sem_Res is function Is_Atomic_Ref_With_Address (N : Node_Id) return Boolean; -- N is either an indexed component or a selected component. This function - -- returns true if the prefix refers to an object that has an address + -- returns true if the prefix denotes an atomic object that has an address -- clause (the case in which we may want to issue a warning). function Is_Definite_Access_Type (E : Entity_Id) return Boolean; @@ -823,7 +823,10 @@ package body Sem_Res is procedure Check_For_Visible_Operator (N : Node_Id; T : Entity_Id) is begin - if Is_Invisible_Operator (N, T) then + if Comes_From_Source (N) + and then not Is_Visible_Operator (Original_Node (N), T) + and then not Error_Posted (N) + then Error_Msg_NE -- CODEFIX ("operator for} is not directly visible!", N, First_Subtype (T)); Error_Msg_N -- CODEFIX @@ -1662,6 +1665,14 @@ package body Sem_Res is begin Op_Node := New_Node (Operator_Kind (Op_Name, Is_Binary), Sloc (N)); + -- Preserve the Comes_From_Source flag on the result if the original + -- call came from source. Although it is not strictly the case that the + -- operator as such comes from the source, logically it corresponds + -- exactly to the function call in the source, so it should be marked + -- this way (e.g. to make sure that validity checks work fine). + + Preserve_Comes_From_Source (Op_Node, N); + -- Ensure that the corresponding operator has the same parent as the -- original call. This guarantees that parent traversals performed by -- the ABE mechanism succeed. @@ -1900,18 +1911,7 @@ package body Sem_Res is Set_Entity (Op_Node, Op_Id); Generate_Reference (Op_Id, N, ' '); - -- Do rewrite setting Comes_From_Source on the result if the original - -- call came from source. Although it is not strictly the case that the - -- operator as such comes from the source, logically it corresponds - -- exactly to the function call in the source, so it should be marked - -- this way (e.g. to make sure that validity checks work fine). - - declare - CS : constant Boolean := Comes_From_Source (N); - begin - Rewrite (N, Op_Node); - Set_Comes_From_Source (N, CS); - end; + Rewrite (N, Op_Node); -- If this is an arithmetic operator and the result type is private, -- the operands and the result must be wrapped in conversion to @@ -4148,15 +4148,38 @@ package body Sem_Res is if No (A) and then Needs_No_Actuals (Nam) then null; - -- If we have an error in any actual or formal, indicated by a type + -- If we have an error in any formal or actual, indicated by a type -- of Any_Type, then abandon resolution attempt, and set result type - -- to Any_Type. Skip this if the actual is a Raise_Expression, whose - -- type is imposed from context. + -- to Any_Type. - elsif (Present (A) and then Etype (A) = Any_Type) - or else Etype (F) = Any_Type - then - if Nkind (A) /= N_Raise_Expression then + elsif Etype (F) = Any_Type then + Set_Etype (N, Any_Type); + return; + + elsif Present (A) and then Etype (A) = Any_Type then + -- For the peculiar case of a user-defined comparison or equality + -- operator that does not return a boolean type, the operands may + -- have been ambiguous for the predefined operator and, therefore, + -- marked with Any_Type. Since the operation has been resolved to + -- the user-defined operator, that is irrelevant, so reset Etype. + + if Nkind (Original_Node (N)) in N_Op_Eq + | N_Op_Ge + | N_Op_Gt + | N_Op_Le + | N_Op_Lt + | N_Op_Ne + and then not Is_Boolean_Type (Etype (N)) + then + Set_Etype (A, Etype (F)); + + -- Also skip this if the actual is a Raise_Expression, whose type + -- is imposed from context. + + elsif Nkind (A) = N_Raise_Expression then + null; + + else Set_Etype (N, Any_Type); return; end if; @@ -6856,13 +6879,11 @@ package body Sem_Res is -- functional notation. Replace call node with operator node, so -- that actuals can be resolved appropriately. - if Is_Predefined_Op (Nam) or else Ekind (Nam) = E_Operator then - Make_Call_Into_Operator (N, Typ, Entity (Name (N))); + if Ekind (Nam) = E_Operator or else Is_Predefined_Op (Nam) then + Make_Call_Into_Operator (N, Typ, Nam); return; - elsif Present (Alias (Nam)) - and then Is_Predefined_Op (Alias (Nam)) - then + elsif Present (Alias (Nam)) and then Is_Predefined_Op (Alias (Nam)) then Resolve_Actuals (N, Nam); Make_Call_Into_Operator (N, Typ, Alias (Nam)); return; @@ -7325,7 +7346,7 @@ package body Sem_Res is -- loops, as this would create complex actions inside -- the condition, that are not handled by GNATprove. - elsif In_While_Loop_Condition (N) then + elsif In_Statement_Condition_With_Actions (N) then Cannot_Inline ("cannot inline & (in while loop condition)?", N, Nam_UA); @@ -7489,39 +7510,35 @@ package body Sem_Res is -- Resolve_Comparison_Op -- --------------------------- - -- Context requires a boolean type, and plays no role in resolution. - -- Processing identical to that for equality operators. The result type is - -- the base type, which matters when pathological subtypes of booleans with - -- limited ranges are used. + -- The operands must have compatible types and the boolean context does not + -- participate in the resolution. The first pass verifies that the operands + -- are not ambiguous and sets their type correctly, or to Any_Type in case + -- of ambiguity. If both operands are strings or aggregates, then they are + -- ambiguous even if they carry a single (universal) type. procedure Resolve_Comparison_Op (N : Node_Id; Typ : Entity_Id) is L : constant Node_Id := Left_Opnd (N); R : constant Node_Id := Right_Opnd (N); - T : Entity_Id; - - begin - -- If this is an intrinsic operation which is not predefined, use the - -- types of its declared arguments to resolve the possibly overloaded - -- operands. Otherwise the operands are unambiguous and specify the - -- expected type. - if Scope (Entity (N)) /= Standard_Standard then - T := Etype (First_Entity (Entity (N))); - - else - T := Find_Unique_Type (L, R); + T : Entity_Id := Find_Unique_Type (L, R); - if T = Any_Fixed then - T := Unique_Fixed_Point_Type (L); - end if; + begin + if T = Any_Fixed then + T := Unique_Fixed_Point_Type (L); end if; Set_Etype (N, Base_Type (Typ)); Generate_Reference (T, N, ' '); - -- Skip remaining processing if already set to Any_Type - if T = Any_Type then + -- Deal with explicit ambiguity of operands + + if Ekind (Entity (N)) = E_Operator + and then (Is_Overloaded (L) or else Is_Overloaded (R)) + then + Ambiguous_Operands (N); + end if; + return; end if; @@ -7578,7 +7595,7 @@ package body Sem_Res is Local : Entity_Id := Empty; function Replace_Local (N : Node_Id) return Traverse_Result; - -- Use a tree traversal to replace each ocurrence of the name of + -- Use a tree traversal to replace each occurrence of the name of -- a local object declared in the construct, with the corresponding -- entity. This replaces the usual way to perform name capture by -- visibility, because it is not possible to place on the scope @@ -7615,7 +7632,7 @@ package body Sem_Res is procedure Replace_Local_Ref is new Traverse_Proc (Replace_Local); - -- Start of processing for Resolve_Declare_Expression + -- Start of processing for Resolve_Declare_Expression begin @@ -7628,6 +7645,19 @@ package body Sem_Res is then Local := Defining_Identifier (Decl); Replace_Local_Ref (Expr); + + -- Traverse the expression to replace references to local + -- variables that occur within declarations of the + -- declare_expression. + + declare + D : Node_Id := Next (Decl); + begin + while Present (D) loop + Replace_Local_Ref (D); + Next (D); + end loop; + end; end if; Next (Decl); @@ -8510,25 +8540,38 @@ package body Sem_Res is -- overlapping actuals, just like for a subprogram call. Warn_On_Overlapping_Actuals (Nam, N); - end Resolve_Entry_Call; ------------------------- -- Resolve_Equality_Op -- ------------------------- - -- Both arguments must have the same type, and the boolean context does - -- not participate in the resolution. The first pass verifies that the - -- interpretation is not ambiguous, and the type of the left argument is - -- correctly set, or is Any_Type in case of ambiguity. If both arguments - -- are strings or aggregates, allocators, or Null, they are ambiguous even - -- though they carry a single (universal) type. Diagnose this case here. + -- The operands must have compatible types and the boolean context does not + -- participate in the resolution. The first pass verifies that the operands + -- are not ambiguous and sets their type correctly, or to Any_Type in case + -- of ambiguity. If both operands are strings, aggregates, allocators, or + -- null, they are ambiguous even if they carry a single (universal) type. procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id) is - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); + T : Entity_Id := Find_Unique_Type (L, R); + procedure Check_Access_Attribute (N : Node_Id); + -- For any object, '[Unchecked_]Access of such object can never be + -- passed as an operand to the Universal_Access equality operators. + -- This is so because the expected type for Obj'Access in a call to + -- these operators, whose formals are of type Universal_Access, is + -- Universal_Access, and Universal_Access does not have a designated + -- type. For more details, see RM 3.10.2(2/2) and 6.4.1(3). + + procedure Check_Designated_Object_Types (T1, T2 : Entity_Id); + -- Check RM 4.5.2(9.6/2) on the given designated object types + + procedure Check_Designated_Subprogram_Types (T1, T2 : Entity_Id); + -- Check RM 4.5.2(9.7/2) on the given designated subprogram types + procedure Check_If_Expression (Cond : Node_Id); -- The resolution rule for if expressions requires that each such must -- have a unique type. This means that if several dependent expressions @@ -8554,6 +8597,54 @@ package body Sem_Res is -- could be the cause of confused priorities. Note that if the not is -- in parens, then False is returned. + ---------------------------- + -- Check_Access_Attribute -- + ---------------------------- + + procedure Check_Access_Attribute (N : Node_Id) is + begin + if Nkind (N) = N_Attribute_Reference + and then Attribute_Name (N) in Name_Access | Name_Unchecked_Access + then + Error_Msg_N + ("access attribute cannot be used as actual for " + & "universal_access equality", N); + end if; + end Check_Access_Attribute; + + ----------------------------------- + -- Check_Designated_Object_Types -- + ----------------------------------- + + procedure Check_Designated_Object_Types (T1, T2 : Entity_Id) is + begin + if (Is_Elementary_Type (T1) or else Is_Array_Type (T1)) + and then (Base_Type (T1) /= Base_Type (T2) + or else not Subtypes_Statically_Match (T1, T2)) + then + Error_Msg_N + ("designated subtypes for universal_access equality " + & "do not statically match (RM 4.5.2(9.6/2)", N); + Error_Msg_NE ("\left operand has}!", N, Etype (L)); + Error_Msg_NE ("\right operand has}!", N, Etype (R)); + end if; + end Check_Designated_Object_Types; + + --------------------------------------- + -- Check_Designated_Subprogram_Types -- + --------------------------------------- + + procedure Check_Designated_Subprogram_Types (T1, T2 : Entity_Id) is + begin + if not Subtype_Conformant (T1, T2) then + Error_Msg_N + ("designated subtypes for universal_access equality " + & "not subtype conformant (RM 4.5.2(9.7/2)", N); + Error_Msg_NE ("\left operand has}!", N, Etype (L)); + Error_Msg_NE ("\right operand has}!", N, Etype (R)); + end if; + end Check_Designated_Subprogram_Types; + ------------------------- -- Check_If_Expression -- ------------------------- @@ -8727,14 +8818,25 @@ package body Sem_Res is -- Start of processing for Resolve_Equality_Op begin - Set_Etype (N, Base_Type (Typ)); - Generate_Reference (T, N, ' '); - if T = Any_Fixed then T := Unique_Fixed_Point_Type (L); end if; - if T /= Any_Type then + Set_Etype (N, Base_Type (Typ)); + Generate_Reference (T, N, ' '); + + if T = Any_Type then + -- Deal with explicit ambiguity of operands + + if Ekind (Entity (N)) = E_Operator + and then (Is_Overloaded (L) or else Is_Overloaded (R)) + then + Ambiguous_Operands (N); + end if; + + else + -- Deal with other error cases + if T = Any_String or else T = Any_Composite or else T = Any_Character @@ -8773,6 +8875,44 @@ package body Sem_Res is Check_If_Expression (R); end if; + -- RM 4.5.2(9.5/2): At least one of the operands of the equality + -- operators for universal_access shall be of type universal_access, + -- or both shall be of access-to-object types, or both shall be of + -- access-to-subprogram types (RM 4.5.2(9.5/2)). + + if Is_Anonymous_Access_Type (T) + and then Etype (L) /= Universal_Access + and then Etype (R) /= Universal_Access + then + -- RM 4.5.2(9.6/2): When both are of access-to-object types, the + -- designated types shall be the same or one shall cover the other + -- and if the designated types are elementary or array types, then + -- the designated subtypes shall statically match. + + if Is_Access_Object_Type (Etype (L)) + and then Is_Access_Object_Type (Etype (R)) + then + Check_Designated_Object_Types + (Designated_Type (Etype (L)), Designated_Type (Etype (R))); + + -- RM 4.5.2(9.7/2): When both are of access-to-subprogram types, + -- the designated profiles shall be subtype conformant. + + elsif Is_Access_Subprogram_Type (Etype (L)) + and then Is_Access_Subprogram_Type (Etype (R)) + then + Check_Designated_Subprogram_Types + (Designated_Type (Etype (L)), Designated_Type (Etype (R))); + end if; + end if; + + -- Check another case of equality operators for universal_access + + if Is_Anonymous_Access_Type (T) and then Comes_From_Source (N) then + Check_Access_Attribute (L); + Check_Access_Attribute (R); + end if; + Resolve (L, T); Resolve (R, T); @@ -8895,33 +9035,6 @@ package body Sem_Res is then Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N)); end if; - - -- Ada 2005: If one operand is an anonymous access type, convert the - -- other operand to it, to ensure that the underlying types match in - -- the back-end. Same for access_to_subprogram, and the conversion - -- verifies that the types are subtype conformant. - - -- We apply the same conversion in the case one of the operands is a - -- private subtype of the type of the other. - - -- Why the Expander_Active test here ??? - - if Expander_Active - and then - (Ekind (T) in E_Anonymous_Access_Type - | E_Anonymous_Access_Subprogram_Type - or else Is_Private_Type (T)) - then - if Etype (L) /= T then - Rewrite (L, Unchecked_Convert_To (T, L)); - Analyze_And_Resolve (L, T); - end if; - - if (Etype (R)) /= T then - Rewrite (R, Unchecked_Convert_To (Etype (L), R)); - Analyze_And_Resolve (R, T); - end if; - end if; end if; end Resolve_Equality_Op; @@ -12592,63 +12705,49 @@ package body Sem_Res is end; end if; - -- Rewrite the operator node using the real operator, not its renaming. - -- Exclude user-defined intrinsic operations of the same name, which are - -- treated separately and rewritten as calls. - - if Ekind (Op) /= E_Function or else Chars (N) /= Nam then - Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N)); - Set_Chars (Op_Node, Nam); - Set_Etype (Op_Node, Etype (N)); - Set_Entity (Op_Node, Op); - Set_Right_Opnd (Op_Node, Right_Opnd (N)); - - -- Indicate that both the original entity and its renaming are - -- referenced at this point. - - Generate_Reference (Entity (N), N); - Generate_Reference (Op, N); + Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N)); + Set_Chars (Op_Node, Nam); + Set_Etype (Op_Node, Etype (N)); + Set_Entity (Op_Node, Op); + Set_Right_Opnd (Op_Node, Right_Opnd (N)); - if Is_Binary then - Set_Left_Opnd (Op_Node, Left_Opnd (N)); - end if; + if Is_Binary then + Set_Left_Opnd (Op_Node, Left_Opnd (N)); + end if; - Rewrite (N, Op_Node); + -- Indicate that both the original entity and its renaming are + -- referenced at this point. - -- If the context type is private, add the appropriate conversions so - -- that the operator is applied to the full view. This is done in the - -- routines that resolve intrinsic operators. + Generate_Reference (Entity (N), N); + Generate_Reference (Op, N); - if Is_Intrinsic_Subprogram (Op) and then Is_Private_Type (Typ) then - case Nkind (N) is - when N_Op_Add - | N_Op_Divide - | N_Op_Expon - | N_Op_Mod - | N_Op_Multiply - | N_Op_Rem - | N_Op_Subtract - => - Resolve_Intrinsic_Operator (N, Typ); - - when N_Op_Abs - | N_Op_Minus - | N_Op_Plus - => - Resolve_Intrinsic_Unary_Operator (N, Typ); + Rewrite (N, Op_Node); - when others => - Resolve (N, Typ); - end case; - end if; + -- If the context type is private, add the appropriate conversions so + -- that the operator is applied to the full view. This is done in the + -- routines that resolve intrinsic operators. - elsif Ekind (Op) = E_Function and then Is_Intrinsic_Subprogram (Op) then + if Is_Intrinsic_Subprogram (Op) and then Is_Private_Type (Typ) then + case Nkind (N) is + when N_Op_Add + | N_Op_Divide + | N_Op_Expon + | N_Op_Mod + | N_Op_Multiply + | N_Op_Rem + | N_Op_Subtract + => + Resolve_Intrinsic_Operator (N, Typ); - -- Operator renames a user-defined operator of the same name. Use the - -- original operator in the node, which is the one Gigi knows about. + when N_Op_Abs + | N_Op_Minus + | N_Op_Plus + => + Resolve_Intrinsic_Unary_Operator (N, Typ); - Set_Entity (N, Op); - Set_Is_Overloaded (N, False); + when others => + Resolve (N, Typ); + end case; end if; end Rewrite_Renamed_Operator; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 8a00e97..4cb0d8d 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -192,10 +192,6 @@ package body Sem_Type is -- multiple interpretations. Interpretations can be added to only one -- node at a time. - function Specific_Type (Typ_1, Typ_2 : Entity_Id) return Entity_Id; - -- If Typ_1 and Typ_2 are compatible, return the one that is not universal - -- or is not a "class" type (any_character, etc). - -------------------- -- Add_One_Interp -- -------------------- @@ -365,14 +361,12 @@ package body Sem_Type is -- Start of processing for Add_One_Interp begin - -- If the interpretation is a predefined operator, verify that the - -- result type is visible, or that the entity has already been - -- resolved (case of an instantiation node that refers to a predefined - -- operation, or an internally generated operator node, or an operator - -- given as an expanded name). If the operator is a comparison or - -- equality, it is the type of the operand that matters to determine - -- whether the operator is visible. In an instance, the check is not - -- performed, given that the operator was visible in the generic. + -- If the interpretation is a predefined operator, verify that it is + -- visible, or that the entity has already been resolved (case of an + -- instantiation node that refers to a predefined operation, or an + -- internally generated operator node, or an operator given as an + -- expanded name). If the operator is a comparison or equality, then + -- it is the type of the operand that is relevant here. if Ekind (E) = E_Operator then if Present (Opnd_Type) then @@ -381,29 +375,9 @@ package body Sem_Type is Vis_Type := Base_Type (T); end if; - if In_Open_Scopes (Scope (Vis_Type)) - or else Is_Potentially_Use_Visible (Vis_Type) - or else In_Use (Vis_Type) - or else (In_Use (Scope (Vis_Type)) - and then not Is_Hidden (Vis_Type)) - or else Nkind (N) = N_Expanded_Name + if Nkind (N) = N_Expanded_Name or else (Nkind (N) in N_Op and then E = Entity (N)) - or else (In_Instance or else In_Inlined_Body) - or else Is_Anonymous_Access_Type (Vis_Type) - then - null; - - -- If the node is given in functional notation and the prefix - -- is an expanded name, then the operator is visible if the - -- prefix is the scope of the result type as well. If the - -- operator is (implicitly) defined in an extension of system, - -- it is know to be valid (see Defined_In_Scope, sem_ch4.adb). - - elsif Nkind (N) = N_Function_Call - and then Nkind (Name (N)) = N_Expanded_Name - and then (Entity (Prefix (Name (N))) = Scope (Base_Type (T)) - or else Entity (Prefix (Name (N))) = Scope (Vis_Type) - or else Scope (Vis_Type) = System_Aux_Id) + or else Is_Visible_Operator (N, Vis_Type) then null; @@ -1334,7 +1308,7 @@ package body Sem_Type is -- It may given by an operator name, or by an expanded name whose prefix -- is Standard. - function Remove_Conversions return Interp; + function Remove_Conversions_And_Abstract_Operations return Interp; -- Last chance for pathological cases involving comparisons on literals, -- and user overloadings of the same operator. Such pathologies have -- been removed from the ACVC, but still appear in two DEC tests, with @@ -1522,11 +1496,11 @@ package body Sem_Type is return Etype (Opnd); end Operand_Type; - ------------------------ - -- Remove_Conversions -- - ------------------------ + ------------------------------------------------ + -- Remove_Conversions_And_Abstract_Operations -- + ------------------------------------------------ - function Remove_Conversions return Interp is + function Remove_Conversions_And_Abstract_Operations return Interp is I : Interp_Index; It : Interp; It1 : Interp; @@ -1535,13 +1509,16 @@ package body Sem_Type is Act2 : Node_Id; function Has_Abstract_Interpretation (N : Node_Id) return Boolean; - -- If an operation has universal operands the universal operation + -- If an operation has universal operands, the universal operation -- is present among its interpretations. If there is an abstract -- interpretation for the operator, with a numeric result, this -- interpretation was already removed in sem_ch4, but the universal -- one is still visible. We must rescan the list of operators and -- remove the universal interpretation to resolve the ambiguity. + function Is_Numeric_Only_Type (T : Entity_Id) return Boolean; + -- Return True if T is a numeric type and not Any_Type + --------------------------------- -- Has_Abstract_Interpretation -- --------------------------------- @@ -1562,7 +1539,7 @@ package body Sem_Type is while Present (E) loop if Is_Overloadable (E) and then Is_Abstract_Subprogram (E) - and then Is_Numeric_Type (Etype (E)) + and then Is_Numeric_Only_Type (Etype (E)) then return True; else @@ -1587,7 +1564,16 @@ package body Sem_Type is end if; end Has_Abstract_Interpretation; - -- Start of processing for Remove_Conversions + -------------------------- + -- Is_Numeric_Only_Type -- + -------------------------- + + function Is_Numeric_Only_Type (T : Entity_Id) return Boolean is + begin + return Is_Numeric_Type (T) and then T /= Any_Type; + end Is_Numeric_Only_Type; + + -- Start of processing for Remove_Conversions_And_Abstract_Operations begin It1 := No_Interp; @@ -1676,11 +1662,11 @@ package body Sem_Type is It1 := It; end if; - elsif Is_Numeric_Type (Etype (F1)) + elsif Is_Numeric_Only_Type (Etype (F1)) and then Has_Abstract_Interpretation (Act1) then -- Current interpretation is not the right one because it - -- expects a numeric operand. Examine all the other ones. + -- expects a numeric operand. Examine all the others. declare I : Interp_Index; @@ -1689,14 +1675,14 @@ package body Sem_Type is begin Get_First_Interp (N, I, It); while Present (It.Typ) loop - if - not Is_Numeric_Type (Etype (First_Formal (It.Nam))) + if not Is_Numeric_Only_Type + (Etype (First_Formal (It.Nam))) then if No (Act2) - or else not Has_Abstract_Interpretation (Act2) or else not - Is_Numeric_Type + Is_Numeric_Only_Type (Etype (Next_Formal (First_Formal (It.Nam)))) + or else not Has_Abstract_Interpretation (Act2) then return It; end if; @@ -1707,44 +1693,46 @@ package body Sem_Type is return No_Interp; end; - end if; - end if; - - <<Next_Interp>> - Get_Next_Interp (I, It); - end loop; - -- After some error, a formal may have Any_Type and yield a spurious - -- match. To avoid cascaded errors if possible, check for such a - -- formal in either candidate. + elsif Is_Numeric_Only_Type (Etype (F1)) + and then Present (Act2) + and then Has_Abstract_Interpretation (Act2) + then + -- Current interpretation is not the right one because it + -- expects a numeric operand. Examine all the others. - if Serious_Errors_Detected > 0 then - declare - Formal : Entity_Id; + declare + I : Interp_Index; + It : Interp; - begin - Formal := First_Formal (Nam1); - while Present (Formal) loop - if Etype (Formal) = Any_Type then - return Disambiguate.It2; - end if; + begin + Get_First_Interp (N, I, It); + while Present (It.Typ) loop + if not Is_Numeric_Only_Type + (Etype (Next_Formal (First_Formal (It.Nam)))) + then + if not Is_Numeric_Only_Type + (Etype (First_Formal (It.Nam))) + or else not Has_Abstract_Interpretation (Act1) + then + return It; + end if; + end if; - Next_Formal (Formal); - end loop; + Get_Next_Interp (I, It); + end loop; - Formal := First_Formal (Nam2); - while Present (Formal) loop - if Etype (Formal) = Any_Type then - return Disambiguate.It1; - end if; + return No_Interp; + end; + end if; + end if; - Next_Formal (Formal); - end loop; - end; - end if; + <<Next_Interp>> + Get_Next_Interp (I, It); + end loop; return It1; - end Remove_Conversions; + end Remove_Conversions_And_Abstract_Operations; ----------------------- -- Standard_Operator -- @@ -2145,10 +2133,10 @@ package body Sem_Type is end if; else - return Remove_Conversions; + return Remove_Conversions_And_Abstract_Operations; end if; else - return Remove_Conversions; + return Remove_Conversions_And_Abstract_Operations; end if; end if; @@ -2162,18 +2150,19 @@ package body Sem_Type is then return No_Interp; - -- If the user-defined operator is in an open scope, or in the scope - -- of the resulting type, or given by an expanded name that names its - -- scope, it hides the predefined operator for the type. Exponentiation - -- has to be special-cased because the implicit operator does not have - -- a symmetric signature, and may not be hidden by the explicit one. - - elsif (Nkind (N) = N_Function_Call - and then Nkind (Name (N)) = N_Expanded_Name - and then (Chars (Predef_Subp) /= Name_Op_Expon - or else Hides_Op (User_Subp, Predef_Subp)) - and then Scope (User_Subp) = Entity (Prefix (Name (N)))) - or else Hides_Op (User_Subp, Predef_Subp) + -- If the user-defined operator matches the signature of the operator, + -- and is declared in an open scope, or in the scope of the resulting + -- type, or given by an expanded name that names its scope, it hides + -- the predefined operator for the type. But exponentiation has to be + -- special-cased because the latter operator does not have a symmetric + -- signature, and may not be hidden by the explicit one. + + elsif Hides_Op (User_Subp, Predef_Subp) + or else (Nkind (N) = N_Function_Call + and then Nkind (Name (N)) = N_Expanded_Name + and then (Chars (Predef_Subp) /= Name_Op_Expon + or else Hides_Op (User_Subp, Predef_Subp)) + and then Scope (User_Subp) = Entity (Prefix (Name (N)))) then if It1.Nam = User_Subp then return It1; @@ -2246,7 +2235,7 @@ package body Sem_Type is end if; else - return No_Interp; + return Remove_Conversions_And_Abstract_Operations; end if; elsif It1.Nam = Predef_Subp then @@ -2264,8 +2253,8 @@ package body Sem_Type is function Entity_Matches_Spec (Old_S, New_S : Entity_Id) return Boolean is begin - -- Simple case: same entity kinds, type conformance is required. A - -- parameterless function can also rename a literal. + -- For the simple case of same kinds, type conformance is required, but + -- a parameterless function can also rename a literal. if Ekind (Old_S) = Ekind (New_S) or else (Ekind (New_S) = E_Function @@ -2273,12 +2262,16 @@ package body Sem_Type is then return Type_Conformant (New_S, Old_S); - elsif Ekind (New_S) = E_Function and then Ekind (Old_S) = E_Operator then - return Operator_Matches_Spec (Old_S, New_S); + -- Likewise for a procedure and an entry elsif Ekind (New_S) = E_Procedure and then Is_Entry (Old_S) then return Type_Conformant (New_S, Old_S); + -- For a user-defined operator, use the dedicated predicate + + elsif Ekind (New_S) = E_Function and then Ekind (Old_S) = E_Operator then + return Operator_Matches_Spec (Old_S, New_S); + else return False; end if; @@ -2289,60 +2282,18 @@ package body Sem_Type is ---------------------- function Find_Unique_Type (L : Node_Id; R : Node_Id) return Entity_Id is - T : constant Entity_Id := Etype (L); - I : Interp_Index; - It : Interp; - TR : Entity_Id := Any_Type; + T : constant Entity_Id := Specific_Type (Etype (L), Etype (R)); begin - if Is_Overloaded (R) then - Get_First_Interp (R, I, It); - while Present (It.Typ) loop - if Covers (T, It.Typ) or else Covers (It.Typ, T) then - - -- If several interpretations are possible and L is universal, - -- apply preference rule. - - if TR /= Any_Type then - if Is_Universal_Numeric_Type (T) - and then It.Typ = T - then - TR := It.Typ; - end if; - - else - TR := It.Typ; - end if; - end if; - - Get_Next_Interp (I, It); - end loop; - - Set_Etype (R, TR); - - -- In the non-overloaded case, the Etype of R is already set correctly - - else - null; + if T = Any_Type then + if Is_User_Defined_Literal (L, Etype (R)) then + return Etype (R); + elsif Is_User_Defined_Literal (R, Etype (L)) then + return Etype (L); + end if; end if; - -- If one of the operands is Universal_Fixed, the type of the other - -- operand provides the context. - - if Etype (R) = Universal_Fixed then - return T; - - elsif T = Universal_Fixed then - return Etype (R); - - -- If one operand is a raise_expression, use type of other operand - - elsif Nkind (L) = N_Raise_Expression then - return Etype (R); - - else - return Specific_Type (T, Etype (R)); - end if; + return T; end Find_Unique_Type; ------------------------------------- @@ -2446,10 +2397,7 @@ package body Sem_Type is -- Has_Compatible_Type -- ------------------------- - function Has_Compatible_Type - (N : Node_Id; - Typ : Entity_Id; - For_Comparison : Boolean := False) return Boolean + function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean is I : Interp_Index; It : Interp; @@ -2463,8 +2411,8 @@ package body Sem_Type is if Covers (Typ, Etype (N)) -- Ada 2005 (AI-345): The context may be a synchronized interface. - -- If the type is already frozen use the corresponding_record - -- to check whether it is a proper descendant. + -- If the type is already frozen, use the corresponding_record to + -- check whether it is a proper descendant. or else (Is_Record_Type (Typ) @@ -2478,23 +2426,8 @@ package body Sem_Type is and then Present (Corresponding_Record_Type (Typ)) and then Covers (Corresponding_Record_Type (Typ), Etype (N))) - or else - (Nkind (N) = N_Integer_Literal - and then Present (Find_Aspect (Typ, Aspect_Integer_Literal))) + or else Is_User_Defined_Literal (N, Typ) - or else - (Nkind (N) = N_Real_Literal - and then Present (Find_Aspect (Typ, Aspect_Real_Literal))) - - or else - (Nkind (N) = N_String_Literal - and then Present (Find_Aspect (Typ, Aspect_String_Literal))) - - or else - (For_Comparison - and then not Is_Tagged_Type (Typ) - and then Ekind (Typ) /= E_Anonymous_Access_Type - and then Covers (Etype (N), Typ)) then return True; end if; @@ -2504,26 +2437,24 @@ package body Sem_Type is else Get_First_Interp (N, I, It); while Present (It.Typ) loop - if (Covers (Typ, It.Typ) - and then - (Scope (It.Nam) /= Standard_Standard - or else not Is_Invisible_Operator (N, Base_Type (Typ)))) + if Covers (Typ, It.Typ) -- Ada 2005 (AI-345) or else (Is_Record_Type (Typ) and then Is_Concurrent_Type (It.Typ) - and then Present (Corresponding_Record_Type - (Etype (It.Typ))) - and then Covers (Typ, Corresponding_Record_Type - (Etype (It.Typ)))) - - or else - (For_Comparison - and then not Is_Tagged_Type (Typ) - and then Ekind (Typ) /= E_Anonymous_Access_Type - and then Covers (It.Typ, Typ)) + and then Present (Corresponding_Record_Type (Etype (It.Typ))) + and then + Covers (Typ, Corresponding_Record_Type (Etype (It.Typ)))) + + or else + (Is_Concurrent_Type (Typ) + and then Is_Record_Type (It.Typ) + and then Present (Corresponding_Record_Type (Typ)) + and then + Covers (Corresponding_Record_Type (Typ), Etype (It.Typ))) + then return True; end if; @@ -3010,45 +2941,6 @@ package body Sem_Type is end if; end Is_Ancestor; - --------------------------- - -- Is_Invisible_Operator -- - --------------------------- - - function Is_Invisible_Operator - (N : Node_Id; - T : Entity_Id) return Boolean - is - Orig_Node : constant Node_Id := Original_Node (N); - - begin - if Nkind (N) not in N_Op then - return False; - - elsif not Comes_From_Source (N) then - return False; - - elsif No (Universal_Interpretation (Right_Opnd (N))) then - return False; - - elsif Nkind (N) in N_Binary_Op - and then No (Universal_Interpretation (Left_Opnd (N))) - then - return False; - - else - return Is_Numeric_Type (T) - and then not In_Open_Scopes (Scope (T)) - and then not Is_Potentially_Use_Visible (T) - and then not In_Use (T) - and then not In_Use (Scope (T)) - and then - (Nkind (Orig_Node) /= N_Function_Call - or else Nkind (Name (Orig_Node)) /= N_Expanded_Name - or else Entity (Prefix (Name (Orig_Node))) /= Scope (T)) - and then not In_Instance; - end if; - end Is_Invisible_Operator; - -------------------- -- Is_Progenitor -- -------------------- @@ -3081,6 +2973,65 @@ package body Sem_Type is return False; end Is_Subtype_Of; + ------------------------- + -- Is_Visible_Operator -- + ------------------------- + + function Is_Visible_Operator (N : Node_Id; Typ : Entity_Id) return Boolean + is + begin + -- The predefined operators of the universal types are always visible + + if Typ in Universal_Integer | Universal_Real | Universal_Access then + return True; + + -- AI95-0230: Keep restriction imposed by Ada 83 and 95, do not allow + -- anonymous access types in universal_access equality operators. + + elsif Is_Anonymous_Access_Type (Typ) then + return Ada_Version >= Ada_2005; + + -- Similar reasoning for special types used for composite types before + -- type resolution is done. + + elsif Typ = Any_Composite or else Typ = Any_String then + return True; + + -- Within an instance, the predefined operators of the formal types are + -- visible and, for the other types, the generic package declaration has + -- already been successfully analyzed. Likewise for an inlined body. + + elsif In_Instance or else In_Inlined_Body then + return True; + + -- If the operation is given in functional notation and the prefix is an + -- expanded name, then the operator is visible if the prefix is the scope + -- of the type, or System if the type is declared in an extension of it. + + elsif Nkind (N) = N_Function_Call + and then Nkind (Name (N)) = N_Expanded_Name + then + declare + Pref : constant Entity_Id := Entity (Prefix (Name (N))); + Scop : constant Entity_Id := Scope (Typ); + + begin + return Pref = Scop + or else (Present (System_Aux_Id) + and then Scop = System_Aux_Id + and then Pref = Scope (Scop)); + end; + + -- Otherwise the operator is visible when the type is visible + + else + return Is_Potentially_Use_Visible (Typ) + or else In_Use (Typ) + or else (In_Use (Scope (Typ)) and then not Is_Hidden (Typ)) + or else In_Open_Scopes (Scope (Typ)); + end if; + end Is_Visible_Operator; + ------------------ -- List_Interps -- ------------------ @@ -3184,7 +3135,7 @@ package body Sem_Type is elsif Op_Name in Name_Op_Eq | Name_Op_Ne then return Base_Type (T1) = Base_Type (T2) - and then not Is_Limited_Type (T1) + and then Valid_Equality_Arg (T1) and then Is_Boolean_Type (T); elsif Op_Name in Name_Op_Lt | Name_Op_Le | Name_Op_Gt | Name_Op_Ge @@ -3366,60 +3317,41 @@ package body Sem_Type is or else (T1 = Universal_Real and then Is_Real_Type (T2)) or else (T1 = Universal_Fixed and then Is_Fixed_Point_Type (T2)) or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2)) + or else (T1 = Any_Modular and then Is_Modular_Integer_Type (T2)) + or else (T1 = Any_Character and then Is_Character_Type (T2)) + or else (T1 = Any_String and then Is_String_Type (T2)) + or else (T1 = Any_Composite and then Is_Aggregate_Type (T2)) then return B2; - elsif (T2 = Universal_Integer and then Is_Integer_Type (T1)) - or else (T2 = Universal_Real and then Is_Real_Type (T1)) - or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1)) - or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1)) + elsif (T1 = Universal_Access + or else Ekind (T1) in E_Allocator_Type | E_Access_Attribute_Type) + and then (Is_Access_Type (T2) or else Is_Remote_Access (T2)) then - return B1; - - elsif T2 = Any_String and then Is_String_Type (T1) then - return B1; - - elsif T1 = Any_String and then Is_String_Type (T2) then return B2; - elsif T2 = Any_Character and then Is_Character_Type (T1) then - return B1; - - elsif T1 = Any_Character and then Is_Character_Type (T2) then + elsif T1 = Raise_Type then return B2; - elsif T1 = Universal_Access - and then (Is_Access_Type (T2) or else Is_Remote_Access (T2)) + elsif (T2 = Universal_Integer and then Is_Integer_Type (T1)) + or else (T2 = Universal_Real and then Is_Real_Type (T1)) + or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1)) + or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1)) + or else (T2 = Any_Modular and then Is_Modular_Integer_Type (T1)) + or else (T2 = Any_Character and then Is_Character_Type (T1)) + or else (T2 = Any_String and then Is_String_Type (T1)) + or else (T2 = Any_Composite and then Is_Aggregate_Type (T1)) then - return T2; + return B1; - elsif T2 = Universal_Access + elsif (T2 = Universal_Access + or else Ekind (T2) in E_Allocator_Type | E_Access_Attribute_Type) and then (Is_Access_Type (T1) or else Is_Remote_Access (T1)) then - return T1; - - -- In an instance, the specific type may have a private view. Use full - -- view to check legality. - - elsif T2 = Universal_Access - and then Is_Private_Type (T1) - and then Present (Full_View (T1)) - and then Is_Access_Type (Full_View (T1)) - and then In_Instance - then - return T1; - - elsif T2 = Any_Composite and then Is_Aggregate_Type (T1) then - return T1; - - elsif T1 = Any_Composite and then Is_Aggregate_Type (T2) then - return T2; - - elsif T1 = Any_Modular and then Is_Modular_Integer_Type (T2) then - return T2; + return B1; - elsif T2 = Any_Modular and then Is_Modular_Integer_Type (T1) then - return T1; + elsif T2 = Raise_Type then + return B1; -- ---------------------------------------------------------- -- Special cases for equality operators (all other predefined @@ -3488,16 +3420,6 @@ package body Sem_Type is then return T1; - elsif Ekind (T1) in E_Allocator_Type | E_Access_Attribute_Type - and then Is_Access_Type (T2) - then - return T2; - - elsif Ekind (T2) in E_Allocator_Type | E_Access_Attribute_Type - and then Is_Access_Type (T1) - then - return T1; - -- Ada 2005 (AI-230): Support the following operators: -- function "=" (L, R : universal_access) return Boolean; @@ -3513,16 +3435,34 @@ package body Sem_Type is -- Note that this does not preclude one operand to be a pool-specific -- access type, as a previous version of this code enforced. - elsif Ada_Version >= Ada_2005 then - if Is_Anonymous_Access_Type (T1) - and then Is_Access_Type (T2) - then - return T1; + elsif Is_Anonymous_Access_Type (T1) + and then Is_Access_Type (T2) + and then Ada_Version >= Ada_2005 + then + return T1; - elsif Is_Anonymous_Access_Type (T2) - and then Is_Access_Type (T1) - then - return T2; + elsif Is_Anonymous_Access_Type (T2) + and then Is_Access_Type (T1) + and then Ada_Version >= Ada_2005 + then + return T2; + + -- In instances, also check private views the same way as Covers + + elsif Is_Private_Type (T1) and then In_Instance then + if Present (Full_View (T1)) then + return Specific_Type (Full_View (T1), T2); + + elsif Present (Underlying_Full_View (T1)) then + return Specific_Type (Underlying_Full_View (T1), T2); + end if; + + elsif Is_Private_Type (T2) and then In_Instance then + if Present (Full_View (T2)) then + return Specific_Type (T1, Full_View (T2)); + + elsif Present (Underlying_Full_View (T2)) then + return Specific_Type (T1, Underlying_Full_View (T2)); end if; end if; @@ -3580,15 +3520,14 @@ package body Sem_Type is -- Valid_Comparison_Arg -- -------------------------- + -- See above for the reason why aggregates and strings are included + function Valid_Comparison_Arg (T : Entity_Id) return Boolean is begin + if Is_Discrete_Type (T) or else Is_Real_Type (T) then + return True; - if T = Any_Composite then - return False; - - elsif Is_Discrete_Type (T) - or else Is_Real_Type (T) - then + elsif T = Any_Composite or else T = Any_String then return True; elsif Is_Array_Type (T) @@ -3608,11 +3547,40 @@ package body Sem_Type is elsif Is_String_Type (T) then return True; + else return False; end if; end Valid_Comparison_Arg; + ------------------------ + -- Valid_Equality_Arg -- + ------------------------ + + -- Same reasoning as above but implicit because of the nonlimited test + + function Valid_Equality_Arg (T : Entity_Id) return Boolean is + begin + -- AI95-0230: Keep restriction imposed by Ada 83 and 95, do not allow + -- anonymous access types in universal_access equality operators. + + if Is_Anonymous_Access_Type (T) then + return Ada_Version >= Ada_2005; + + elsif not Is_Limited_Type (T) then + return True; + + elsif Is_Array_Type (T) + and then not Is_Limited_Type (Component_Type (T)) + and then Available_Full_View_Of_Component (T) + then + return True; + + else + return False; + end if; + end Valid_Equality_Arg; + ------------------ -- Write_Interp -- ------------------ diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index bdb44d6..a6111b1 100644 --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -103,9 +103,12 @@ package Sem_Type is -- in N. If the name is an expanded name, the homonyms are only those that -- belong to the same scope. - function Is_Invisible_Operator (N : Node_Id; T : Entity_Id) return Boolean; - -- Check whether a predefined operation with universal operands appears in - -- a context in which the operators of the expected type are not visible. + function Is_Visible_Operator (N : Node_Id; Typ : Entity_Id) return Boolean; + -- Determine whether a predefined operation is performed in a context where + -- the predefined operators of base type Typ are visible. The existence of + -- this routine is an implementation artifact. A more straightforward but + -- more space-consuming choice would be to make all inherited operators + -- explicit in the symbol table. See also Sem_ch8.Has_Implicit_Operator. procedure List_Interps (Nam : Node_Id; Err : Node_Id); -- List candidate interpretations of an overloaded name. Used for various @@ -181,22 +184,15 @@ package Sem_Type is -- opposed to an operator, type and mode conformance are required. function Find_Unique_Type (L : Node_Id; R : Node_Id) return Entity_Id; - -- Used in second pass of resolution, for equality and comparison nodes. L - -- is the left operand, whose type is known to be correct, and R is the - -- right operand, which has one interpretation compatible with that of L. - -- Return the type intersection of the two. - - function Has_Compatible_Type - (N : Node_Id; - Typ : Entity_Id; - For_Comparison : Boolean := False) return Boolean; + -- Used in type resolution for equality and comparison nodes. L and R are + -- the operands, whose type is known to be correct or Any_Type in case of + -- ambiguity. Return the type intersection of the two. + + function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean; -- Verify that some interpretation of the node N has a type compatible with -- Typ. If N is not overloaded, then its unique type must be compatible -- with Typ. Otherwise iterate through the interpretations of N looking for - -- a compatible one. If For_Comparison is true, the function is invoked for - -- a comparison (or equality) operator and also needs to verify the reverse - -- compatibility, because the implementation of type resolution for these - -- operators is not fully symmetrical. + -- a compatible one. function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean; -- A user-defined function hides a predefined operator if it matches the @@ -259,13 +255,22 @@ package Sem_Type is procedure Set_Abstract_Op (I : Interp_Index; V : Entity_Id); -- Set the abstract operation field of an interpretation - function Valid_Comparison_Arg (T : Entity_Id) return Boolean; - -- A valid argument to an ordering operator must be a discrete type, a - -- real type, or a one dimensional array with a discrete component type. + function Specific_Type (Typ_1, Typ_2 : Entity_Id) return Entity_Id; + -- If Typ_1 and Typ_2 are compatible, return the one that is not universal + -- or is not a "class" type (any_character, etc). function Valid_Boolean_Arg (T : Entity_Id) return Boolean; - -- A valid argument of a boolean operator is either some boolean type, or a - -- one-dimensional array of boolean type. + -- A valid argument of a predefined boolean operator must be a boolean type + -- or a 1-dimensional array of boolean type. + + function Valid_Comparison_Arg (T : Entity_Id) return Boolean; + -- A valid argument of a predefined comparison operator must be a discrete + -- type, real type or a 1-dimensional array with a discrete component type. + + function Valid_Equality_Arg (T : Entity_Id) return Boolean; + -- A valid argument of a predefined equality operator must be a nonlimited + -- type or an array with a limited private component whose full view is not + -- limited. procedure Write_Interp (It : Interp); -- Debugging procedure to display an Interp diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3c55dda..d76b5d9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1719,6 +1719,31 @@ package body Sem_Util is Error_Msg_FE (Msg, N, Typ); end if; + -- Suggest to use First_Valid/Last_Valid instead of First/Last/Range + -- if the predicate is static. + + if not Has_Dynamic_Predicate_Aspect (Typ) + and then Has_Static_Predicate (Typ) + and then Nkind (N) = N_Attribute_Reference + then + declare + Aname : constant Name_Id := Attribute_Name (N); + Attr_Id : constant Attribute_Id := Get_Attribute_Id (Aname); + begin + case Attr_Id is + when Attribute_First => + Error_Msg_F ("\use attribute First_Valid instead", N); + when Attribute_Last => + Error_Msg_F ("\use attribute Last_Valid instead", N); + when Attribute_Range => + Error_Msg_F ("\use attributes First_Valid and " + & "Last_Valid instead", N); + when others => + null; + end case; + end; + end if; + -- Emit an optional suggestion on how to remedy the error if the -- context warrants it. @@ -14986,41 +15011,58 @@ package body Sem_Util is return False; end In_Return_Value; - --------------------- - -- In_Visible_Part -- - --------------------- - - function In_Visible_Part (Scope_Id : Entity_Id) return Boolean is - begin - return Is_Package_Or_Generic_Package (Scope_Id) - and then In_Open_Scopes (Scope_Id) - and then not In_Package_Body (Scope_Id) - and then not In_Private_Part (Scope_Id); - end In_Visible_Part; - - ----------------------------- - -- In_While_Loop_Condition -- - ----------------------------- + ----------------------------------------- + -- In_Statement_Condition_With_Actions -- + ----------------------------------------- - function In_While_Loop_Condition (N : Node_Id) return Boolean is + function In_Statement_Condition_With_Actions (N : Node_Id) return Boolean is Prev : Node_Id := N; P : Node_Id := Parent (N); -- P and Prev will be used for traversing the AST, while maintaining an -- invariant that P = Parent (Prev). begin - loop - if No (P) then - return False; - elsif Nkind (P) = N_Iteration_Scheme + while Present (P) loop + if Nkind (P) = N_Iteration_Scheme and then Prev = Condition (P) then return True; - else - Prev := P; - P := Parent (P); + + elsif Nkind (P) = N_Elsif_Part + and then Prev = Condition (P) + then + return True; + + -- No point in going beyond statements + + elsif Nkind (N) in N_Statement_Other_Than_Procedure_Call + | N_Procedure_Call_Statement + then + exit; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (P) then + exit; end if; + + Prev := P; + P := Parent (P); end loop; - end In_While_Loop_Condition; + + return False; + end In_Statement_Condition_With_Actions; + + --------------------- + -- In_Visible_Part -- + --------------------- + + function In_Visible_Part (Scope_Id : Entity_Id) return Boolean is + begin + return Is_Package_Or_Generic_Package (Scope_Id) + and then In_Open_Scopes (Scope_Id) + and then not In_Package_Body (Scope_Id) + and then not In_Private_Part (Scope_Id); + end In_Visible_Part; -------------------------------- -- Incomplete_Or_Partial_View -- @@ -19533,9 +19575,7 @@ package body Sem_Util is if Nkind (Original_Node (AV)) in N_Function_Call | N_Aggregate then return False; - elsif Comes_From_Source (AV) - and then Nkind (Original_Node (Expression (AV))) = N_Function_Call - then + elsif Nkind (Original_Node (Expression (AV))) = N_Function_Call then return False; elsif Nkind (Original_Node (AV)) = N_Type_Conversion then @@ -21478,6 +21518,25 @@ package body Sem_Util is and then Nkind (Parent (Id)) = N_Function_Specification; end Is_User_Defined_Equality; + ----------------------------- + -- Is_User_Defined_Literal -- + ----------------------------- + + function Is_User_Defined_Literal + (N : Node_Id; + Typ : Entity_Id) return Boolean + is + Literal_Aspect_Map : + constant array (N_Numeric_Or_String_Literal) of Aspect_Id := + (N_Integer_Literal => Aspect_Integer_Literal, + N_Real_Literal => Aspect_Real_Literal, + N_String_Literal => Aspect_String_Literal); + + begin + return Nkind (N) in N_Numeric_Or_String_Literal + and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N)))); + end Is_User_Defined_Literal; + -------------------------------------- -- Is_Validation_Variable_Reference -- -------------------------------------- @@ -25698,10 +25757,11 @@ package body Sem_Util is -- of pragma Unused. if Has_Pragma_Unused (Ent) then - Error_Msg_NE ("??pragma Unused given for &!", N, Ent); + Error_Msg_NE + ("??aspect Unused specified for &!", N, Ent); else Error_Msg_NE - ("??pragma Unmodified given for &!", N, Ent); + ("??aspect Unmodified specified for &!", N, Ent); end if; end if; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 695158a..78fc347 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1723,14 +1723,18 @@ package Sem_Util is -- This version is more efficient than calling the single root version of -- Is_Subtree twice. + function In_Statement_Condition_With_Actions (N : Node_Id) return Boolean; + -- Returns true if the expression N occurs within the condition of a + -- statement node with actions. Subsidiary to inlining for GNATprove, where + -- inlining of function calls in such expressions would expand the called + -- body into actions list of the condition node. GNATprove cannot yet cope + -- with such a complex AST. + function In_Visible_Part (Scope_Id : Entity_Id) return Boolean; -- Determine whether a declaration occurs within the visible part of a -- package specification. The package must be on the scope stack, and the -- corresponding private part must not. - function In_While_Loop_Condition (N : Node_Id) return Boolean; - -- Returns true if the expression N occurs within the condition of a while - function Incomplete_Or_Partial_View (Id : Entity_Id) return Entity_Id; -- Given the entity of a constant or a type, retrieve the incomplete or -- partial view of the same entity. Note that Id may not have a partial @@ -2468,6 +2472,12 @@ package Sem_Util is function Is_User_Defined_Equality (Id : Entity_Id) return Boolean; -- Determine whether an entity denotes a user-defined equality + function Is_User_Defined_Literal + (N : Node_Id; + Typ : Entity_Id) return Boolean; + pragma Inline (Is_User_Defined_Literal); + -- Determine whether N is a user-defined literal for Typ + function Is_Validation_Variable_Reference (N : Node_Id) return Boolean; -- Determine whether N denotes a reference to a variable which captures the -- value of an object for validation purposes. diff --git a/gcc/ada/sigtramp-vxworks.c b/gcc/ada/sigtramp-vxworks.c index 138e3d0..357a834 100644 --- a/gcc/ada/sigtramp-vxworks.c +++ b/gcc/ada/sigtramp-vxworks.c @@ -49,15 +49,15 @@ typedef struct mcontext { - REG_SET regs; + REG_SET regs; } mcontext_t; typedef struct ucontext { - mcontext_t uc_mcontext; /* register set */ - struct ucontext * uc_link; /* not used */ - sigset_t uc_sigmask; /* set of signals blocked */ - stack_t uc_stack; /* stack of context signaled */ + mcontext_t uc_mcontext; /* register set */ + struct ucontext * uc_link; /* not used */ + sigset_t uc_sigmask; /* set of signals blocked */ + stack_t uc_stack; /* stack of context signaled */ } ucontext_t; #endif diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 5c13061..921c1d2 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -1431,7 +1431,7 @@ package body Uintp is N := N / Uint_2; exit when N = Uint_0; - Squares := Squares * Squares; + Squares := Squares * Squares; end loop; Uintp.Release_And_Save (M, Result); @@ -2233,30 +2233,17 @@ package body Uintp is function UI_To_CC (Input : Valid_Uint) return Char_Code is begin - if Direct (Input) then - return Char_Code (Direct_Val (Input)); + -- Char_Code and Int have equal upper bounds, so simply guard against + -- negative Input and reuse conversion to Int. We trust that conversion + -- to Int will raise Constraint_Error when Input is too large. - -- Case of input is more than one digit + pragma Assert + (Char_Code'First = 0 and then Int (Char_Code'Last) = Int'Last); + if Input >= Uint_0 then + return Char_Code (UI_To_Int (Input)); else - declare - In_Length : constant Int := N_Digits (Input); - In_Vec : UI_Vector (1 .. In_Length); - Ret_CC : Char_Code; - - begin - Init_Operand (Input, In_Vec); - - -- We assume value is positive - - Ret_CC := 0; - for Idx in In_Vec'Range loop - Ret_CC := Ret_CC * Char_Code (Base) + - Char_Code (abs In_Vec (Idx)); - end loop; - - return Ret_CC; - end; + raise Constraint_Error; end if; end UI_To_CC; diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb index 22e4705..8f6fb7a 100644 --- a/gcc/ada/xr_tabls.adb +++ b/gcc/ada/xr_tabls.adb @@ -819,7 +819,7 @@ package body Xr_Tabls is end if; end Internal_Strip; - -- Start of processing for Get_File; + -- Start of processing for Get_File begin -- If we do not want the full path name diff --git a/gcc/basic-block.h b/gcc/basic-block.h index e3fff1f..21a9b24 100644 --- a/gcc/basic-block.h +++ b/gcc/basic-block.h @@ -158,10 +158,7 @@ struct GTY((chain_next ("%h.next_bb"), chain_prev ("%h.prev_bb"))) basic_block_d /* This ensures that struct gimple_bb_info is smaller than struct rtl_bb_info, so that inlining the former into basic_block_def is the better choice. */ -typedef int __assert_gimple_bb_smaller_rtl_bb - [(int) sizeof (struct rtl_bb_info) - - (int) sizeof (struct gimple_bb_info)]; - +STATIC_ASSERT (sizeof (rtl_bb_info) >= sizeof (gimple_bb_info)); #define BB_FREQ_MAX 10000 diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 347db0c..972c68b 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,24 @@ +2022-05-07 Marek Polacek <polacek@redhat.com> + + PR c++/101833 + PR c++/47634 + * c-attribs.cc (positional_argument): Pass POS by reference. Deal + with FN being either a function declaration or function type. Use + maybe_adjust_arg_pos_for_attribute. + * c-common.cc (check_function_arguments): Maybe pass FNDECL down to + check_function_format. + * c-common.h (maybe_adjust_arg_pos_for_attribute): Declare. + (positional_argument): Adjust. + * c-format.cc (get_constant): Rename to ... + (validate_constant): ... this. Take EXPR by reference. Return bool + instead of tree. + (handle_format_arg_attribute): Don't overwrite FORMAT_NUM_EXPR by the + return value of validate_constant. + (decode_format_attr): Don't overwrite FORMAT_NUM_EXPR and + FIRST_ARG_NUM_EXPR by the return value of validate_constant. + (check_function_format): Adjust a parameter name. + (handle_format_attribute): Maybe pass FNDECL down to decode_format_attr. + 2022-05-04 Marek Polacek <polacek@redhat.com> * c-warn.cc (warnings_for_convert_and_check): Convert constants of type diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc index b1953a4..0f047a1 100644 --- a/gcc/c-family/c-attribs.cc +++ b/gcc/c-family/c-attribs.cc @@ -594,18 +594,23 @@ attribute_takes_identifier_p (const_tree attr_id) } /* Verify that argument value POS at position ARGNO to attribute NAME - applied to function TYPE refers to a function parameter at position - POS and the expected type CODE. Treat CODE == INTEGER_TYPE as - matching all C integral types except bool. If successful, return - POS after default conversions, if any. Otherwise, issue appropriate - warnings and return null. A non-zero 1-based ARGNO should be passed - in by callers only for attributes with more than one argument. */ + applied to function FN (which is either a function declaration or function + type) refers to a function parameter at position POS and the expected type + CODE. Treat CODE == INTEGER_TYPE as matching all C integral types except + bool. If successful, return POS after default conversions (and possibly + adjusted by ADJUST_POS). Otherwise, issue appropriate warnings and return + null. A non-zero 1-based ARGNO should be passed in by callers only for + attributes with more than one argument. + + N.B. This function modifies POS. */ tree -positional_argument (const_tree fntype, const_tree atname, tree pos, +positional_argument (const_tree fn, const_tree atname, tree &pos, tree_code code, int argno /* = 0 */, int flags /* = posargflags () */) { + const_tree fndecl = TYPE_P (fn) ? NULL_TREE : fn; + const_tree fntype = TYPE_P (fn) ? fn : TREE_TYPE (fn); if (pos && TREE_CODE (pos) != IDENTIFIER_NODE && TREE_CODE (pos) != FUNCTION_DECL) pos = default_conversion (pos); @@ -682,6 +687,11 @@ positional_argument (const_tree fntype, const_tree atname, tree pos, if (!prototype_p (fntype)) return pos; + /* ADJUST_POS is non-zero in C++ when the function type has invisible + parameters generated by the compiler, such as the in-charge or VTT + parameters. */ + const int adjust_pos = maybe_adjust_arg_pos_for_attribute (fndecl); + /* Verify that the argument position does not exceed the number of formal arguments to the function. When POSARG_ELLIPSIS is set, ARGNO may be beyond the last argument of a vararg @@ -690,7 +700,7 @@ positional_argument (const_tree fntype, const_tree atname, tree pos, if (!nargs || !tree_fits_uhwi_p (pos) || ((flags & POSARG_ELLIPSIS) == 0 - && !IN_RANGE (tree_to_uhwi (pos), 1, nargs))) + && !IN_RANGE (tree_to_uhwi (pos) + adjust_pos, 1, nargs))) { if (argno < 1) @@ -707,8 +717,9 @@ positional_argument (const_tree fntype, const_tree atname, tree pos, } /* Verify that the type of the referenced formal argument matches - the expected type. */ - unsigned HOST_WIDE_INT ipos = tree_to_uhwi (pos); + the expected type. Invisible parameters may have been added by + the compiler, so adjust the position accordingly. */ + unsigned HOST_WIDE_INT ipos = tree_to_uhwi (pos) + adjust_pos; /* Zero was handled above. */ gcc_assert (ipos != 0); @@ -791,7 +802,7 @@ positional_argument (const_tree fntype, const_tree atname, tree pos, return NULL_TREE; } - return pos; + return build_int_cst (TREE_TYPE (pos), ipos); } /* Return the first of DECL or TYPE attributes installed in NODE if it's diff --git a/gcc/c-family/c-common.cc b/gcc/c-family/c-common.cc index 730faa9..6156e5f 100644 --- a/gcc/c-family/c-common.cc +++ b/gcc/c-family/c-common.cc @@ -6071,8 +6071,8 @@ check_function_arguments (location_t loc, const_tree fndecl, const_tree fntype, /* Check for errors in format strings. */ if (warn_format || warn_suggest_attribute_format) - check_function_format (fntype, TYPE_ATTRIBUTES (fntype), nargs, argarray, - arglocs); + check_function_format (fndecl ? fndecl : fntype, TYPE_ATTRIBUTES (fntype), nargs, + argarray, arglocs); if (warn_format) check_function_sentinel (fntype, nargs, argarray); diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index 52a85bf..aa043de 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -950,7 +950,6 @@ extern bool c_common_post_options (const char **); extern bool c_common_init (void); extern void c_common_finish (void); extern void c_common_parse_file (void); -extern FILE *get_dump_info (int, dump_flags_t *); extern alias_set_type c_common_get_alias_set (tree); extern void c_register_builtin_type (tree, const char*); extern bool c_promoting_integer_type_p (const_tree); @@ -1049,6 +1048,7 @@ extern tree finish_label_address_expr (tree, location_t); extern tree lookup_label (tree); extern tree lookup_name (tree); extern bool lvalue_p (const_tree); +extern int maybe_adjust_arg_pos_for_attribute (const_tree); extern bool vector_targets_convertible_p (const_tree t1, const_tree t2); extern bool vector_types_convertible_p (const_tree t1, const_tree t2, bool emit_lax_note); @@ -1493,7 +1493,7 @@ enum posargflags { POSARG_ELLIPSIS = 2 }; -extern tree positional_argument (const_tree, const_tree, tree, tree_code, +extern tree positional_argument (const_tree, const_tree, tree &, tree_code, int = 0, int = posargflags ()); extern enum flt_eval_method diff --git a/gcc/c-family/c-format.cc b/gcc/c-family/c-format.cc index 98f28c0..ea57fde8 100644 --- a/gcc/c-family/c-format.cc +++ b/gcc/c-family/c-format.cc @@ -78,9 +78,9 @@ static bool check_format_string (const_tree argument, unsigned HOST_WIDE_INT format_num, int flags, bool *no_add_attrs, int expected_format_type); -static tree get_constant (const_tree fntype, const_tree atname, tree expr, - int argno, unsigned HOST_WIDE_INT *value, - int flags, bool validated_p); +static bool validate_constant (const_tree fn, const_tree atname, tree &expr, + int argno, unsigned HOST_WIDE_INT *value, + int flags, bool validated_p); static const char *convert_format_name_to_system_name (const char *attr_name); static int first_target_format_type; @@ -172,14 +172,12 @@ handle_format_arg_attribute (tree *node, tree atname, tree args, int flags, bool *no_add_attrs) { tree type = *node; - /* Note that TREE_VALUE (args) is changed in place below. */ + /* Note that TREE_VALUE (args) is changed in the validate_constant call. */ tree *format_num_expr = &TREE_VALUE (args); unsigned HOST_WIDE_INT format_num = 0; - if (tree val = get_constant (type, atname, *format_num_expr, 0, &format_num, - 0, false)) - *format_num_expr = val; - else + if (!validate_constant (type, atname, *format_num_expr, 0, &format_num, 0, + false)) { *no_add_attrs = true; return NULL_TREE; @@ -301,38 +299,39 @@ check_format_string (const_tree fntype, unsigned HOST_WIDE_INT format_num, /* Under the control of FLAGS, verify EXPR is a valid constant that refers to a positional argument ARGNO having a string type (char* or, for targets like Darwin, a pointer to struct CFString) to - a function type FNTYPE declared with attribute ATNAME. - If valid, store the constant's integer value in *VALUE and return - the value. - If VALIDATED_P is true assert the validation is successful. - Returns the converted constant value on success, null otherwise. */ + a function FN declared with attribute ATNAME. If valid, store the + constant's integer value in *VALUE and return true. If VALIDATED_P + is true assert the validation is successful. -static tree -get_constant (const_tree fntype, const_tree atname, tree expr, int argno, - unsigned HOST_WIDE_INT *value, int flags, bool validated_p) + N.B. This function modifies EXPR. */ + +static bool +validate_constant (const_tree fn, const_tree atname, tree &expr, int argno, + unsigned HOST_WIDE_INT *value, int flags, bool validated_p) { /* Require the referenced argument to have a string type. For targets like Darwin, also accept pointers to struct CFString. */ - if (tree val = positional_argument (fntype, atname, expr, STRING_CST, + if (tree val = positional_argument (fn, atname, expr, STRING_CST, argno, flags)) { *value = TREE_INT_CST_LOW (val); - return val; + return true; } gcc_assert (!validated_p); - return NULL_TREE; + return false; } /* Decode the arguments to a "format" attribute into a function_format_info structure. It is already known that the list is of the right length. If VALIDATED_P is true, then these attributes have already been validated and must not be erroneous; - if false, it will give an error message. Returns true if the - attributes are successfully decoded, false otherwise. */ + if false, it will give an error message. FN is either a function + declaration or function type. Returns true if the attributes are + successfully decoded, false otherwise. */ static bool -decode_format_attr (const_tree fntype, tree atname, tree args, +decode_format_attr (const_tree fn, tree atname, tree args, function_format_info *info, bool validated_p) { tree format_type_id = TREE_VALUE (args); @@ -372,17 +371,13 @@ decode_format_attr (const_tree fntype, tree atname, tree args, } } - if (tree val = get_constant (fntype, atname, *format_num_expr, - 2, &info->format_num, 0, validated_p)) - *format_num_expr = val; - else + if (!validate_constant (fn, atname, *format_num_expr, 2, &info->format_num, + 0, validated_p)) return false; - if (tree val = get_constant (fntype, atname, *first_arg_num_expr, - 3, &info->first_arg_num, - (POSARG_ZERO | POSARG_ELLIPSIS), validated_p)) - *first_arg_num_expr = val; - else + if (!validate_constant (fn, atname, *first_arg_num_expr, 3, + &info->first_arg_num, + (POSARG_ZERO | POSARG_ELLIPSIS), validated_p)) return false; if (info->first_arg_num != 0 && info->first_arg_num <= info->format_num) @@ -1154,13 +1149,12 @@ decode_format_type (const char *s, bool *is_raw /* = NULL */) /* Check the argument list of a call to printf, scanf, etc. ATTRS are the attributes on the function type. There are NARGS argument - values in the array ARGARRAY. - Also, if -Wsuggest-attribute=format, - warn for calls to vprintf or vscanf in functions with no such format - attribute themselves. */ + values in the array ARGARRAY. FN is either a function declaration or + function type. Also, if -Wsuggest-attribute=format, warn for calls to + vprintf or vscanf in functions with no such format attribute themselves. */ void -check_function_format (const_tree fntype, tree attrs, int nargs, +check_function_format (const_tree fn, tree attrs, int nargs, tree *argarray, vec<location_t> *arglocs) { tree a; @@ -1174,7 +1168,7 @@ check_function_format (const_tree fntype, tree attrs, int nargs, { /* Yup; check it. */ function_format_info info; - decode_format_attr (fntype, atname, TREE_VALUE (a), &info, + decode_format_attr (fn, atname, TREE_VALUE (a), &info, /*validated=*/true); if (warn_format) { @@ -5150,10 +5144,14 @@ convert_format_name_to_system_name (const char *attr_name) /* Handle a "format" attribute; arguments as in struct attribute_spec.handler. */ tree -handle_format_attribute (tree *node, tree atname, tree args, +handle_format_attribute (tree node[3], tree atname, tree args, int flags, bool *no_add_attrs) { const_tree type = *node; + /* NODE[2] may be NULL, and it also may be a PARM_DECL for function + pointers. */ + const_tree fndecl = ((node[2] && TREE_CODE (node[2]) == FUNCTION_DECL) + ? node[2] : NULL_TREE); function_format_info info; #ifdef TARGET_FORMAT_TYPES @@ -5179,7 +5177,8 @@ handle_format_attribute (tree *node, tree atname, tree args, if (TREE_CODE (TREE_VALUE (args)) == IDENTIFIER_NODE) TREE_VALUE (args) = canonicalize_attr_name (TREE_VALUE (args)); - if (!decode_format_attr (type, atname, args, &info, /* validated_p = */false)) + if (!decode_format_attr (fndecl ? fndecl : type, atname, args, &info, + /* validated_p = */false)) { *no_add_attrs = true; return NULL_TREE; diff --git a/gcc/c-family/c-gimplify.cc b/gcc/c-family/c-gimplify.cc index a00b0a0..a6f26c9 100644 --- a/gcc/c-family/c-gimplify.cc +++ b/gcc/c-family/c-gimplify.cc @@ -40,6 +40,7 @@ along with GCC; see the file COPYING3. If not see #include "dumpfile.h" #include "c-ubsan.h" #include "tree-nested.h" +#include "context.h" /* The gimplification pass converts the language-dependent trees (ld-trees) emitted by the parser into language-independent trees @@ -552,6 +553,7 @@ c_genericize_control_r (tree *stmt_p, int *walk_subtrees, void *data) void c_genericize (tree fndecl) { + dump_file_info *dfi; FILE *dump_orig; dump_flags_t local_dump_flags; struct cgraph_node *cgn; @@ -581,7 +583,9 @@ c_genericize (tree fndecl) do_warn_duplicated_branches_r, NULL); /* Dump the C-specific tree IR. */ - dump_orig = get_dump_info (TDI_original, &local_dump_flags); + dfi = g->get_dumps ()->get_dump_file_info (TDI_original); + dump_orig = dfi->pstream; + local_dump_flags = dfi->pflags; if (dump_orig) { fprintf (dump_orig, "\n;; Function %s", diff --git a/gcc/c-family/c-opts.cc b/gcc/c-family/c-opts.cc index a341a06..09a16b2 100644 --- a/gcc/c-family/c-opts.cc +++ b/gcc/c-family/c-opts.cc @@ -41,6 +41,7 @@ along with GCC; see the file COPYING3. If not see #include "mkdeps.h" #include "dumpfile.h" #include "file-prefix-map.h" /* add_*_prefix_map() */ +#include "context.h" #ifndef DOLLARS_IN_IDENTIFIERS # define DOLLARS_IN_IDENTIFIERS true @@ -100,10 +101,6 @@ static size_t deferred_count; /* Number of deferred options scanned for -include. */ static size_t include_cursor; -/* Dump files/flags to use during parsing. */ -static FILE *original_dump_file = NULL; -static dump_flags_t original_dump_flags; - /* Whether any standard preincluded header has been preincluded. */ static bool done_preinclude; @@ -1226,15 +1223,13 @@ c_common_init (void) void c_common_parse_file (void) { - unsigned int i; - - i = 0; - for (;;) + auto dumps = g->get_dumps (); + for (unsigned int i = 0;;) { c_finish_options (); /* Open the dump file to use for the original dump output here, to be used during parsing for the current file. */ - original_dump_file = dump_begin (TDI_original, &original_dump_flags); + dumps->dump_start (TDI_original, &dump_flags); pch_init (); push_file_scope (); c_parse_file (); @@ -1248,29 +1243,15 @@ c_common_parse_file (void) cpp_clear_file_cache (parse_in); this_input_filename = cpp_read_main_file (parse_in, in_fnames[i]); - if (original_dump_file) - { - dump_end (TDI_original, original_dump_file); - original_dump_file = NULL; - } /* If an input file is missing, abandon further compilation. cpplib has issued a diagnostic. */ if (!this_input_filename) break; + dumps->dump_finish (TDI_original); } c_parse_final_cleanups (); -} - -/* Returns the appropriate dump file for PHASE to dump with FLAGS. */ - -FILE * -get_dump_info (int phase, dump_flags_t *flags) -{ - gcc_assert (phase == TDI_original); - - *flags = original_dump_flags; - return original_dump_file; + dumps->dump_finish (TDI_original); } /* Common finish hook for the C, ObjC and C++ front ends. */ diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index b0fef44..b8167c2 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,9 @@ +2022-05-07 Marek Polacek <polacek@redhat.com> + + PR c++/101833 + PR c++/47634 + * c-objc-common.cc (maybe_adjust_arg_pos_for_attribute): New. + 2022-04-08 Jakub Jelinek <jakub@redhat.com> PR c/105149 diff --git a/gcc/c/c-objc-common.cc b/gcc/c/c-objc-common.cc index 97850ad..70e10a9 100644 --- a/gcc/c/c-objc-common.cc +++ b/gcc/c/c-objc-common.cc @@ -394,3 +394,12 @@ c_get_alias_set (tree t) return c_common_get_alias_set (t); } + +/* In C there are no invisible parameters like in C++ (this, in-charge, VTT, + etc.). */ + +int +maybe_adjust_arg_pos_for_attribute (const_tree) +{ + return 0; +} diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 129dd72..d431d5f 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -7669,7 +7669,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, c_inhibit_evaluation_warnings -= cond.value == truthvalue_true_node; location_t loc1 = make_location (exp1.get_start (), exp1.src_range); location_t loc2 = make_location (exp2.get_start (), exp2.src_range); - if (__builtin_expect (omp_atomic_lhs != NULL, 0) + if (UNLIKELY (omp_atomic_lhs != NULL) && (TREE_CODE (cond.value) == GT_EXPR || TREE_CODE (cond.value) == LT_EXPR || TREE_CODE (cond.value) == EQ_EXPR) @@ -7865,7 +7865,7 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after, stack[sp].expr \ = convert_lvalue_to_rvalue (stack[sp].loc, \ stack[sp].expr, true, true); \ - if (__builtin_expect (omp_atomic_lhs != NULL_TREE, 0) && sp == 1 \ + if (UNLIKELY (omp_atomic_lhs != NULL_TREE) && sp == 1 \ && ((c_parser_next_token_is (parser, CPP_SEMICOLON) \ && ((1 << stack[sp].prec) \ & ((1 << PREC_BITOR) | (1 << PREC_BITXOR) \ diff --git a/gcc/cgraph.cc b/gcc/cgraph.cc index 4bb9e7b..23749a2 100644 --- a/gcc/cgraph.cc +++ b/gcc/cgraph.cc @@ -545,12 +545,12 @@ cgraph_node::get_create (tree decl) node->order = first_clone->order; symtab->symtab_prevail_in_asm_name_hash (node); node->decl->decl_with_vis.symtab_node = node; - if (dump_file) + if (dump_file && symtab->state != PARSING) fprintf (dump_file, "Introduced new external node " "(%s) and turned into root of the clone tree.\n", node->dump_name ()); } - else if (dump_file) + else if (dump_file && symtab->state != PARSING) fprintf (dump_file, "Introduced new external node " "(%s).\n", node->dump_name ()); return node; diff --git a/gcc/config/aarch64/iterators.md b/gcc/config/aarch64/iterators.md index e72fdf35..88af964 100644 --- a/gcc/config/aarch64/iterators.md +++ b/gcc/config/aarch64/iterators.md @@ -63,9 +63,6 @@ ;; Iterator for all 16-bit scalar floating point modes (HF, BF) (define_mode_iterator HFBF [HF BF]) -;; Iterator for all scalar floating point modes (HF, SF, DF and TF) -(define_mode_iterator GPF_TF_F16 [HF SF DF TF]) - ;; Iterator for all scalar floating point modes suitable for moving, including ;; special BF type (HF, SF, DF, TF and BF) (define_mode_iterator GPF_TF_F16_MOV [HF BF SF DF TF]) diff --git a/gcc/config/i386/i386-expand.cc b/gcc/config/i386/i386-expand.cc index bc806ff..0fd3028c 100644 --- a/gcc/config/i386/i386-expand.cc +++ b/gcc/config/i386/i386-expand.cc @@ -20941,6 +20941,106 @@ expand_vec_perm_vpshufb2_vpermq_even_odd (struct expand_vec_perm_d *d) return true; } +/* Implement permutation with pslldq + psrldq + por when pshufb is not + available. */ +static bool +expand_vec_perm_pslldq_psrldq_por (struct expand_vec_perm_d *d, bool pandn) +{ + unsigned i, nelt = d->nelt; + unsigned start1, end1 = -1; + machine_mode vmode = d->vmode, imode; + int start2 = -1; + bool clear_op0, clear_op1; + unsigned inner_size; + rtx op0, op1, dop1; + rtx (*gen_vec_shr) (rtx, rtx, rtx); + rtx (*gen_vec_shl) (rtx, rtx, rtx); + + /* pshufd can be used for V4SI/V2DI under TARGET_SSE2. */ + if (!TARGET_SSE2 || (vmode != E_V16QImode && vmode != E_V8HImode)) + return false; + + start1 = d->perm[0]; + for (i = 1; i < nelt; i++) + { + if (d->perm[i] != d->perm[i-1] + 1) + { + if (start2 == -1) + { + start2 = d->perm[i]; + end1 = d->perm[i-1]; + } + else + return false; + } + else if (d->perm[i] >= nelt + && start2 == -1) + { + start2 = d->perm[i]; + end1 = d->perm[i-1]; + } + } + + clear_op0 = end1 != nelt - 1; + clear_op1 = start2 % nelt != 0; + /* pandn/pand is needed to clear upper/lower bits of op0/op1. */ + if (!pandn && (clear_op0 || clear_op1)) + return false; + + if (d->testing_p) + return true; + + gen_vec_shr = vmode == E_V16QImode ? gen_vec_shr_v16qi : gen_vec_shr_v8hi; + gen_vec_shl = vmode == E_V16QImode ? gen_vec_shl_v16qi : gen_vec_shl_v8hi; + imode = GET_MODE_INNER (vmode); + inner_size = GET_MODE_BITSIZE (imode); + op0 = gen_reg_rtx (vmode); + op1 = gen_reg_rtx (vmode); + + if (start1) + emit_insn (gen_vec_shr (op0, d->op0, GEN_INT (start1 * inner_size))); + else + emit_move_insn (op0, d->op0); + + dop1 = d->op1; + if (d->one_operand_p) + dop1 = d->op0; + + int shl_offset = end1 - start1 + 1 - start2 % nelt; + if (shl_offset) + emit_insn (gen_vec_shl (op1, dop1, GEN_INT (shl_offset * inner_size))); + else + emit_move_insn (op1, dop1); + + /* Clear lower/upper bits for op0/op1. */ + if (clear_op0 || clear_op1) + { + rtx vec[16]; + rtx const_vec; + rtx clear; + for (i = 0; i != nelt; i++) + { + if (i < (end1 - start1 + 1)) + vec[i] = gen_int_mode ((HOST_WIDE_INT_1U << inner_size) - 1, imode); + else + vec[i] = CONST0_RTX (imode); + } + const_vec = gen_rtx_CONST_VECTOR (vmode, gen_rtvec_v (nelt, vec)); + const_vec = validize_mem (force_const_mem (vmode, const_vec)); + clear = force_reg (vmode, const_vec); + + if (clear_op0) + emit_move_insn (op0, gen_rtx_AND (vmode, op0, clear)); + if (clear_op1) + emit_move_insn (op1, gen_rtx_AND (vmode, + gen_rtx_NOT (vmode, clear), + op1)); + } + + emit_move_insn (d->target, gen_rtx_IOR (vmode, op0, op1)); + return true; +} + /* A subroutine of expand_vec_perm_even_odd_1. Implement extract-even and extract-odd permutations of two V8QI, V8HI, V16QI, V16HI or V32QI operands with two "and" and "pack" or two "shift" and "pack" insns. @@ -21853,6 +21953,9 @@ ix86_expand_vec_perm_const_1 (struct expand_vec_perm_d *d) if (expand_vec_perm_pshufb2 (d)) return true; + if (expand_vec_perm_pslldq_psrldq_por (d, false)) + return true; + if (expand_vec_perm_interleave3 (d)) return true; @@ -21891,6 +21994,10 @@ ix86_expand_vec_perm_const_1 (struct expand_vec_perm_d *d) if (expand_vec_perm_even_odd (d)) return true; + /* Generate four or five instructions. */ + if (expand_vec_perm_pslldq_psrldq_por (d, true)) + return true; + /* Even longer sequences. */ if (expand_vec_perm_vpshufb4_vpermq2 (d)) return true; diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc index b16df5b..86752a6 100644 --- a/gcc/config/i386/i386.cc +++ b/gcc/config/i386/i386.cc @@ -3706,7 +3706,7 @@ zero_call_used_regno_mode (const unsigned int regno) else if (MASK_REGNO_P (regno)) return HImode; else if (MMX_REGNO_P (regno)) - return V4HImode; + return V2SImode; else gcc_unreachable (); } @@ -3826,19 +3826,12 @@ zero_all_mm_registers (HARD_REG_SET need_zeroed_hardregs, if (!need_zero_all_mm) return false; - rtx zero_mmx = NULL_RTX; - machine_mode mode = V4HImode; + machine_mode mode = V2SImode; for (unsigned int regno = FIRST_MMX_REG; regno <= LAST_MMX_REG; regno++) if (regno != ret_mmx_regno) { rtx reg = gen_rtx_REG (mode, regno); - if (zero_mmx == NULL_RTX) - { - zero_mmx = reg; - emit_insn (gen_rtx_SET (reg, CONST0_RTX (mode))); - } - else - emit_move_insn (reg, zero_mmx); + emit_insn (gen_rtx_SET (reg, CONST0_RTX (mode))); } return true; } @@ -3908,11 +3901,6 @@ ix86_zero_call_used_regs (HARD_REG_SET need_zeroed_hardregs) /* Now, generate instructions to zero all the other registers. */ - rtx zero_gpr = NULL_RTX; - rtx zero_vector = NULL_RTX; - rtx zero_mask = NULL_RTX; - rtx zero_mmx = NULL_RTX; - for (unsigned int regno = 0; regno < FIRST_PSEUDO_REGISTER; regno++) { if (!TEST_HARD_REG_BIT (need_zeroed_hardregs, regno)) @@ -3923,59 +3911,34 @@ ix86_zero_call_used_regs (HARD_REG_SET need_zeroed_hardregs) SET_HARD_REG_BIT (zeroed_hardregs, regno); - rtx reg, tmp, zero_rtx; machine_mode mode = zero_call_used_regno_mode (regno); - reg = gen_rtx_REG (mode, regno); - zero_rtx = CONST0_RTX (mode); + rtx reg = gen_rtx_REG (mode, regno); + rtx tmp = gen_rtx_SET (reg, CONST0_RTX (mode)); - if (mode == SImode) - if (zero_gpr == NULL_RTX) - { - zero_gpr = reg; - tmp = gen_rtx_SET (reg, zero_rtx); - if (!TARGET_USE_MOV0 || optimize_insn_for_size_p ()) - { - rtx clob = gen_rtx_CLOBBER (VOIDmode, - gen_rtx_REG (CCmode, - FLAGS_REG)); - tmp = gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, - tmp, - clob)); - } - emit_insn (tmp); - } - else - emit_move_insn (reg, zero_gpr); - else if (mode == V4SFmode) - if (zero_vector == NULL_RTX) - { - zero_vector = reg; - tmp = gen_rtx_SET (reg, zero_rtx); - emit_insn (tmp); - } - else - emit_move_insn (reg, zero_vector); - else if (mode == HImode) - if (zero_mask == NULL_RTX) - { - zero_mask = reg; - tmp = gen_rtx_SET (reg, zero_rtx); - emit_insn (tmp); - } - else - emit_move_insn (reg, zero_mask); - else if (mode == V4HImode) - if (zero_mmx == NULL_RTX) - { - zero_mmx = reg; - tmp = gen_rtx_SET (reg, zero_rtx); - emit_insn (tmp); - } - else - emit_move_insn (reg, zero_mmx); - else - gcc_unreachable (); + switch (mode) + { + case E_SImode: + if (!TARGET_USE_MOV0 || optimize_insn_for_size_p ()) + { + rtx clob = gen_rtx_CLOBBER (VOIDmode, + gen_rtx_REG (CCmode, + FLAGS_REG)); + tmp = gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, + tmp, + clob)); + } + /* FALLTHRU. */ + + case E_V4SFmode: + case E_HImode: + case E_V2SImode: + emit_insn (tmp); + break; + + default: + gcc_unreachable (); + } } return zeroed_hardregs; } diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index 7b791de..47f8b18 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -22297,15 +22297,52 @@ (set_attr "prefix" "orig,orig,maybe_evex") (set_attr "mode" "TI")]) +(define_insn "*sse4_1_<code>v2qiv2di2<mask_name>_1" + [(set (match_operand:V2DI 0 "register_operand" "=v") + (any_extend:V2DI + (match_operand:V2QI 1 "memory_operand" "m")))] + "TARGET_SSE4_1 && <mask_avx512vl_condition>" + "%vpmov<extsuffix>bq\t{%1, %0<mask_operand2>|%0<mask_operand2>, %1}" + [(set_attr "type" "ssemov") + (set_attr "prefix_extra" "1") + (set_attr "prefix" "maybe_evex") + (set_attr "mode" "TI")]) + (define_expand "<insn>v2qiv2di2" [(set (match_operand:V2DI 0 "register_operand") (any_extend:V2DI - (match_operand:V2QI 1 "register_operand")))] + (match_operand:V2QI 1 "nonimmediate_operand")))] "TARGET_SSE4_1" { - rtx op1 = force_reg (V2QImode, operands[1]); - op1 = lowpart_subreg (V16QImode, op1, V2QImode); - emit_insn (gen_sse4_1_<code>v2qiv2di2 (operands[0], op1)); + if (!MEM_P (operands[1])) + { + rtx op1 = force_reg (V2QImode, operands[1]); + op1 = lowpart_subreg (V16QImode, op1, V2QImode); + emit_insn (gen_sse4_1_<code>v2qiv2di2 (operands[0], op1)); + DONE; + } +}) + +(define_insn_and_split "*sse4_1_zero_extendv2qiv2di2_2" + [(set (match_operand:V2DI 0 "register_operand") + (zero_extend:V2DI + (vec_select:V2QI + (subreg:V16QI + (vec_merge:V8_128 + (vec_duplicate:V8_128 + (match_operand:<ssescalarmode> 1 "nonimmediate_operand")) + (match_operand:V8_128 2 "const0_operand") + (const_int 1)) 0) + (parallel [(const_int 0) (const_int 1)]))))] + "TARGET_SSE4_1 && ix86_pre_reload_split ()" + "#" + "&& 1" + [(const_int 0)] +{ + if (!MEM_P (operands[1])) + operands[1] = force_reg (<ssescalarmode>mode, operands[1]); + operands[1] = lowpart_subreg (V2QImode, operands[1], <ssescalarmode>mode); + emit_insn (gen_zero_extendv2qiv2di2 (operands[0], operands[1])); DONE; }) diff --git a/gcc/config/riscv/arch-canonicalize b/gcc/config/riscv/arch-canonicalize index f36a2ca..41bab69 100755 --- a/gcc/config/riscv/arch-canonicalize +++ b/gcc/config/riscv/arch-canonicalize @@ -70,8 +70,10 @@ def arch_canonicalize(arch, isa_spec): is_isa_spec_2p2 = isa_spec == '2.2' new_arch = "" extra_long_ext = [] + std_exts = [] if arch[:5] in ['rv32e', 'rv32i', 'rv32g', 'rv64i', 'rv64g']: - new_arch = arch[:5].replace("g", "imafd") + new_arch = arch[:5].replace("g", "i") + std_exts = ['m', 'a', 'f', 'd'] if arch[:5] in ['rv32g', 'rv64g']: if not is_isa_spec_2p2: extra_long_ext = ['zicsr', 'zifencei'] @@ -86,10 +88,10 @@ def arch_canonicalize(arch, isa_spec): if long_ext_prefixes_idx: first_long_ext_idx = min(long_ext_prefixes_idx) long_exts = arch[first_long_ext_idx:].split("_") - std_exts = list(arch[5:first_long_ext_idx]) + std_exts += list(arch[5:first_long_ext_idx]) else: long_exts = [] - std_exts = list(arch[5:]) + std_exts += list(arch[5:]) long_exts += extra_long_ext diff --git a/gcc/config/rs6000/rs6000.cc b/gcc/config/rs6000/rs6000.cc index bc61959..4030864 100644 --- a/gcc/config/rs6000/rs6000.cc +++ b/gcc/config/rs6000/rs6000.cc @@ -25350,6 +25350,11 @@ rs6000_can_inline_p (tree caller, tree callee) } } + /* Ignore -mpower8-fusion and -mpower10-fusion options for inlining + purposes. */ + callee_isa &= ~(OPTION_MASK_P8_FUSION | OPTION_MASK_P10_FUSION); + explicit_isa &= ~(OPTION_MASK_P8_FUSION | OPTION_MASK_P10_FUSION); + /* The callee's options must be a subset of the caller's options, i.e. a vsx function may inline an altivec function, but a no-vsx function must not inline a vsx function. However, for those options that the diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 94cdfe0..e72925f 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,27 @@ +2022-05-07 Marek Polacek <polacek@redhat.com> + + PR c++/101833 + PR c++/47634 + * tree.cc (maybe_adjust_arg_pos_for_attribute): New. + +2022-05-06 Jason Merrill <jason@redhat.com> + + * error.cc (decl_to_string): Add show_color parameter. + (subst_to_string): Likewise. + (cp_printer): Pass it. + (type_to_string): Set pp_show_color. + (dump_function_name): Use "fnname" color. + (dump_template_bindings): Use "targs" color. + (struct colorize_guard): New. + (reinit_cxx_pp): Clear pp_show_color. + +2022-05-06 Jason Merrill <jason@redhat.com> + + PR c++/105245 + PR c++/100111 + * constexpr.cc (cxx_eval_store_expression): Reorganize empty base + handling. + 2022-05-05 Marek Polacek <polacek@redhat.com> PR c++/64679 diff --git a/gcc/cp/call.cc b/gcc/cp/call.cc index 959279d..0240e36 100644 --- a/gcc/cp/call.cc +++ b/gcc/cp/call.cc @@ -948,7 +948,7 @@ field_in_pset (hash_set<tree, true> &pset, tree field) for (field = TYPE_FIELDS (TREE_TYPE (field)); field; field = DECL_CHAIN (field)) { - field = next_initializable_field (field); + field = next_aggregate_field (field); if (field == NULL_TREE) break; if (field_in_pset (pset, field)) @@ -965,7 +965,7 @@ build_aggr_conv (tree type, tree ctor, int flags, tsubst_flags_t complain) { unsigned HOST_WIDE_INT i = 0; conversion *c; - tree field = next_initializable_field (TYPE_FIELDS (type)); + tree field = next_aggregate_field (TYPE_FIELDS (type)); tree empty_ctor = NULL_TREE; hash_set<tree, true> pset; @@ -1011,7 +1011,7 @@ build_aggr_conv (tree type, tree ctor, int flags, tsubst_flags_t complain) } } - for (; field; field = next_initializable_field (DECL_CHAIN (field))) + for (; field; field = next_aggregate_field (DECL_CHAIN (field))) { tree ftype = TREE_TYPE (field); tree val; @@ -8098,10 +8098,10 @@ convert_like_internal (conversion *convs, tree expr, tree fn, int argnum, totype = complete_type_or_maybe_complain (totype, NULL_TREE, complain); if (!totype) return error_mark_node; - tree field = next_initializable_field (TYPE_FIELDS (totype)); + tree field = next_aggregate_field (TYPE_FIELDS (totype)); vec<constructor_elt, va_gc> *vec = NULL; CONSTRUCTOR_APPEND_ELT (vec, field, array); - field = next_initializable_field (DECL_CHAIN (field)); + field = next_aggregate_field (DECL_CHAIN (field)); CONSTRUCTOR_APPEND_ELT (vec, field, size_int (len)); tree new_ctor = build_constructor (totype, vec); return get_target_expr_sfinae (new_ctor, complain); @@ -13267,8 +13267,8 @@ type_has_extended_temps (tree type) { if (is_std_init_list (type)) return true; - for (tree f = next_initializable_field (TYPE_FIELDS (type)); - f; f = next_initializable_field (DECL_CHAIN (f))) + for (tree f = next_aggregate_field (TYPE_FIELDS (type)); + f; f = next_aggregate_field (DECL_CHAIN (f))) if (type_has_extended_temps (TREE_TYPE (f))) return true; } diff --git a/gcc/cp/class.cc b/gcc/cp/class.cc index bc94ed4..3c195b3 100644 --- a/gcc/cp/class.cc +++ b/gcc/cp/class.cc @@ -5494,8 +5494,8 @@ default_init_uninitialized_part (tree type) if (r) return r; } - for (t = next_initializable_field (TYPE_FIELDS (type)); t; - t = next_initializable_field (DECL_CHAIN (t))) + for (t = next_aggregate_field (TYPE_FIELDS (type)); t; + t = next_aggregate_field (DECL_CHAIN (t))) if (!DECL_INITIAL (t) && !DECL_ARTIFICIAL (t)) { r = default_init_uninitialized_part (TREE_TYPE (t)); @@ -7781,10 +7781,10 @@ finish_struct (tree t, tree attributes) bool ok = false; if (processing_template_decl) { - tree f = next_initializable_field (TYPE_FIELDS (t)); + tree f = next_aggregate_field (TYPE_FIELDS (t)); if (f && TYPE_PTR_P (TREE_TYPE (f))) { - f = next_initializable_field (DECL_CHAIN (f)); + f = next_aggregate_field (DECL_CHAIN (f)); if (f && same_type_p (TREE_TYPE (f), size_type_node)) ok = true; } diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc index 9b1e718..e560d84 100644 --- a/gcc/cp/constexpr.cc +++ b/gcc/cp/constexpr.cc @@ -784,7 +784,7 @@ cx_check_missing_mem_inits (tree ctype, tree body, bool complain) if (TREE_CODE (ctype) == UNION_TYPE) { - if (nelts == 0 && next_initializable_field (field)) + if (nelts == 0 && next_aggregate_field (field)) { if (complain) error ("%<constexpr%> constructor for union %qT must " @@ -3053,7 +3053,7 @@ reduced_constant_expression_p (tree t) field = NULL_TREE; } else - field = next_initializable_field (TYPE_FIELDS (TREE_TYPE (t))); + field = next_subobject_field (TYPE_FIELDS (TREE_TYPE (t))); } else field = NULL_TREE; @@ -3065,15 +3065,15 @@ reduced_constant_expression_p (tree t) return false; /* Empty class field may or may not have an initializer. */ for (; field && e.index != field; - field = next_initializable_field (DECL_CHAIN (field))) + field = next_subobject_field (DECL_CHAIN (field))) if (!is_really_empty_class (TREE_TYPE (field), /*ignore_vptr*/false)) return false; if (field) - field = next_initializable_field (DECL_CHAIN (field)); + field = next_subobject_field (DECL_CHAIN (field)); } /* There could be a non-empty field at the end. */ - for (; field; field = next_initializable_field (DECL_CHAIN (field))) + for (; field; field = next_subobject_field (DECL_CHAIN (field))) if (!is_really_empty_class (TREE_TYPE (field), /*ignore_vptr*/false)) return false; ok: @@ -5718,6 +5718,7 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, releasing_vec ctors, indexes; auto_vec<int> index_pos_hints; bool activated_union_member_p = false; + bool empty_base = false; while (!refs->is_empty ()) { if (*valp == NULL_TREE) @@ -5759,7 +5760,7 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, no_zero_init = CONSTRUCTOR_NO_CLEARING (*valp); enum tree_code code = TREE_CODE (type); - type = refs->pop(); + tree reftype = refs->pop(); tree index = refs->pop(); if (code == RECORD_TYPE && is_empty_field (index)) @@ -5768,7 +5769,12 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, fields, which confuses the middle-end. The code below will notice that we don't have a CONSTRUCTOR for our inner target and just return init. */ - break; + { + empty_base = true; + break; + } + + type = reftype; if (code == UNION_TYPE && CONSTRUCTOR_NELTS (*valp) && CONSTRUCTOR_ELT (*valp, 0)->index != index) @@ -5902,45 +5908,42 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, } } + if (*non_constant_p) + return t; + /* Don't share a CONSTRUCTOR that might be changed later. */ init = unshare_constructor (init); - if (*valp && TREE_CODE (*valp) == CONSTRUCTOR - && TREE_CODE (init) == CONSTRUCTOR) + gcc_checking_assert (!*valp || (same_type_ignoring_top_level_qualifiers_p + (TREE_TYPE (*valp), type))); + if (empty_base || !(same_type_ignoring_top_level_qualifiers_p + (TREE_TYPE (init), type))) + { + /* For initialization of an empty base, the original target will be + *(base*)this, evaluation of which resolves to the object + argument, which has the derived type rather than the base type. In + this situation, just evaluate the initializer and return, since + there's no actual data to store, and we didn't build a CONSTRUCTOR. */ + empty_base = true; + gcc_assert (is_empty_class (TREE_TYPE (init))); + if (!*valp) + { + /* But do make sure we have something in *valp. */ + *valp = build_constructor (type, nullptr); + CONSTRUCTOR_NO_CLEARING (*valp) = no_zero_init; + } + } + else if (*valp && TREE_CODE (*valp) == CONSTRUCTOR + && TREE_CODE (init) == CONSTRUCTOR) { /* An outer ctx->ctor might be pointing to *valp, so replace its contents. */ - if (!same_type_ignoring_top_level_qualifiers_p (TREE_TYPE (init), - TREE_TYPE (*valp))) - { - /* For initialization of an empty base, the original target will be - *(base*)this, evaluation of which resolves to the object - argument, which has the derived type rather than the base type. In - this situation, just evaluate the initializer and return, since - there's no actual data to store. */ - gcc_assert (is_empty_class (TREE_TYPE (init))); - return lval ? target : init; - } CONSTRUCTOR_ELTS (*valp) = CONSTRUCTOR_ELTS (init); TREE_CONSTANT (*valp) = TREE_CONSTANT (init); TREE_SIDE_EFFECTS (*valp) = TREE_SIDE_EFFECTS (init); CONSTRUCTOR_NO_CLEARING (*valp) = CONSTRUCTOR_NO_CLEARING (init); } - else if (TREE_CODE (init) == CONSTRUCTOR - && !same_type_ignoring_top_level_qualifiers_p (TREE_TYPE (init), - type)) - { - /* See above on initialization of empty bases. */ - gcc_assert (is_empty_class (TREE_TYPE (init)) && !lval); - if (!*valp) - { - /* But do make sure we have something in *valp. */ - *valp = build_constructor (type, nullptr); - CONSTRUCTOR_NO_CLEARING (*valp) = no_zero_init; - } - return init; - } else *valp = init; @@ -5958,7 +5961,7 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, constructor of a delegating constructor). Leave it up to the caller that set 'this' to set TREE_READONLY appropriately. */ gcc_checking_assert (same_type_ignoring_top_level_qualifiers_p - (TREE_TYPE (target), type)); + (TREE_TYPE (target), type) || empty_base); else TREE_READONLY (*valp) = true; } @@ -5980,9 +5983,7 @@ cxx_eval_store_expression (const constexpr_ctx *ctx, tree t, CONSTRUCTOR_NO_CLEARING (elt) = false; } - if (*non_constant_p) - return t; - else if (lval) + if (lval) return target; else return init; diff --git a/gcc/cp/cp-gimplify.cc b/gcc/cp/cp-gimplify.cc index b52d9cb..6f84d15 100644 --- a/gcc/cp/cp-gimplify.cc +++ b/gcc/cp/cp-gimplify.cc @@ -1178,7 +1178,7 @@ cp_genericize_r (tree *stmt_p, int *walk_subtrees, void *data) hash_set<tree> *p_set = wtd->p_set; /* If in an OpenMP context, note var uses. */ - if (__builtin_expect (wtd->omp_ctx != NULL, 0) + if (UNLIKELY (wtd->omp_ctx != NULL) && (VAR_P (stmt) || TREE_CODE (stmt) == PARM_DECL || TREE_CODE (stmt) == RESULT_DECL) @@ -1242,7 +1242,7 @@ cp_genericize_r (tree *stmt_p, int *walk_subtrees, void *data) if (is_invisiref_parm (TREE_OPERAND (stmt, 0))) { /* If in an OpenMP context, note var uses. */ - if (__builtin_expect (wtd->omp_ctx != NULL, 0) + if (UNLIKELY (wtd->omp_ctx != NULL) && omp_var_to_track (TREE_OPERAND (stmt, 0))) omp_cxx_notice_variable (wtd->omp_ctx, TREE_OPERAND (stmt, 0)); *stmt_p = fold_convert (TREE_TYPE (stmt), TREE_OPERAND (stmt, 0)); @@ -1369,7 +1369,7 @@ cp_genericize_r (tree *stmt_p, int *walk_subtrees, void *data) break; case BIND_EXPR: - if (__builtin_expect (wtd->omp_ctx != NULL, 0)) + if (UNLIKELY (wtd->omp_ctx != NULL)) { tree decl; for (decl = BIND_EXPR_VARS (stmt); decl; decl = DECL_CHAIN (decl)) @@ -3106,7 +3106,7 @@ get_source_location_impl_type (location_t loc) int cnt = 0; for (tree field = TYPE_FIELDS (type); - (field = next_initializable_field (field)) != NULL_TREE; + (field = next_aggregate_field (field)) != NULL_TREE; field = DECL_CHAIN (field)) { if (DECL_NAME (field) != NULL_TREE) @@ -3281,7 +3281,7 @@ fold_builtin_source_location (location_t loc) vec<constructor_elt, va_gc> *v = NULL; vec_alloc (v, 4); for (tree field = TYPE_FIELDS (source_location_impl); - (field = next_initializable_field (field)) != NULL_TREE; + (field = next_aggregate_field (field)) != NULL_TREE; field = DECL_CHAIN (field)) { const char *n = IDENTIFIER_POINTER (DECL_NAME (field)); diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index 663fe7a..7e50db0 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -1734,9 +1734,9 @@ check_constraint_info (tree t) (DECL_LANG_SPECIFIC (DECL_MODULE_CHECK (NODE))->u.base.module_entity_p) /* DECL that has attached decls for ODR-relatedness. */ -#define DECL_MODULE_ATTACHMENTS_P(NODE) \ +#define DECL_MODULE_KEYED_DECLS_P(NODE) \ (DECL_LANG_SPECIFIC (TREE_CHECK2(NODE,FUNCTION_DECL,VAR_DECL))\ - ->u.base.module_attached_p) + ->u.base.module_keyed_decls_p) /* Whether this is an exported DECL. Held on any decl that can appear at namespace scope (function, var, type, template, const or @@ -2836,8 +2836,8 @@ struct GTY(()) lang_decl_base { unsigned module_import_p : 1; /* from an import */ unsigned module_entity_p : 1; /* is in the entitity ary & hash. */ - /* VAR_DECL or FUNCTION_DECL has attached decls. */ - unsigned module_attached_p : 1; + /* VAR_DECL or FUNCTION_DECL has keyed decls. */ + unsigned module_keyed_decls_p : 1; /* 12 spare bits. */ }; @@ -6870,7 +6870,8 @@ extern bool is_direct_enum_init (tree, tree); extern void initialize_artificial_var (tree, vec<constructor_elt, va_gc> *); extern tree check_var_type (tree, tree, location_t); extern tree reshape_init (tree, tree, tsubst_flags_t); -extern tree next_initializable_field (tree); +extern tree next_aggregate_field (tree); +extern tree next_subobject_field (tree); extern tree first_field (const_tree); extern tree fndecl_declared_return_type (tree); extern bool undeduced_auto_decl (tree); @@ -7196,7 +7197,7 @@ extern unsigned get_importing_module (tree, bool = false) ATTRIBUTE_PURE; /* Where current instance of the decl got declared/defined/instantiated. */ extern void set_instantiating_module (tree); extern void set_defining_module (tree); -extern void maybe_attach_decl (tree ctx, tree decl); +extern void maybe_key_decl (tree ctx, tree decl); extern void mangle_module (int m, bool include_partition); extern void mangle_module_fini (); diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc index 0fa758f..872b02d 100644 --- a/gcc/cp/decl.cc +++ b/gcc/cp/decl.cc @@ -6384,20 +6384,36 @@ static tree reshape_init_r (tree, reshape_iter *, tree, tsubst_flags_t); /* FIELD is an element of TYPE_FIELDS or NULL. In the former case, the value returned is the next FIELD_DECL (possibly FIELD itself) that can be - initialized. If there are no more such fields, the return value - will be NULL. */ + initialized as if for an aggregate class. If there are no more such fields, + the return value will be NULL. */ tree -next_initializable_field (tree field) +next_aggregate_field (tree field) { while (field && (TREE_CODE (field) != FIELD_DECL || DECL_UNNAMED_BIT_FIELD (field) || (DECL_ARTIFICIAL (field) - /* In C++17, don't skip base class fields. */ - && !(cxx_dialect >= cxx17 && DECL_FIELD_IS_BASE (field)) - /* Don't skip vptr fields. We might see them when we're - called from reduced_constant_expression_p. */ + /* In C++17, aggregates can have bases. */ + && !(cxx_dialect >= cxx17 && DECL_FIELD_IS_BASE (field))))) + field = DECL_CHAIN (field); + + return field; +} + +/* FIELD is an element of TYPE_FIELDS or NULL. In the former case, the value + returned is the next FIELD_DECL (possibly FIELD itself) that corresponds + to a subobject. If there are no more such fields, the return value will be + NULL. */ + +tree +next_subobject_field (tree field) +{ + while (field + && (TREE_CODE (field) != FIELD_DECL + || DECL_UNNAMED_BIT_FIELD (field) + || (DECL_ARTIFICIAL (field) + && !DECL_FIELD_IS_BASE (field) && !DECL_VIRTUAL_P (field)))) field = DECL_CHAIN (field); @@ -6595,7 +6611,7 @@ reshape_init_class (tree type, reshape_iter *d, bool first_initializer_p, if (base_binfo) field = base_binfo; else - field = next_initializable_field (TYPE_FIELDS (type)); + field = next_aggregate_field (TYPE_FIELDS (type)); if (!field) { @@ -6762,10 +6778,10 @@ reshape_init_class (tree type, reshape_iter *d, bool first_initializer_p, if (BINFO_BASE_ITERATE (binfo, ++binfo_idx, base_binfo)) field = base_binfo; else - field = next_initializable_field (TYPE_FIELDS (type)); + field = next_aggregate_field (TYPE_FIELDS (type)); } else - field = next_initializable_field (DECL_CHAIN (field)); + field = next_aggregate_field (DECL_CHAIN (field)); } /* A trailing aggregate element that is a pack expansion is assumed to diff --git a/gcc/cp/error.cc b/gcc/cp/error.cc index 2e9dd2c..250e012 100644 --- a/gcc/cp/error.cc +++ b/gcc/cp/error.cc @@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see #include "cp-tree.h" #include "stringpool.h" #include "tree-diagnostic.h" +#include "diagnostic-color.h" #include "langhooks-def.h" #include "intl.h" #include "cxx-pretty-print.h" @@ -56,7 +57,7 @@ static cxx_pretty_printer * const cxx_pp = &actual_pretty_printer; static const char *args_to_string (tree, int); static const char *code_to_string (enum tree_code); static const char *cv_to_string (tree, int); -static const char *decl_to_string (tree, int); +static const char *decl_to_string (tree, int, bool); static const char *fndecl_to_string (tree, int); static const char *op_to_string (bool, enum tree_code); static const char *parm_to_string (int); @@ -390,6 +391,7 @@ dump_template_bindings (cxx_pretty_printer *pp, tree parms, tree args, else { pp_cxx_whitespace (pp); + pp_string (pp, colorize_start (pp_show_color (pp), "targs")); pp_cxx_left_bracket (pp); pp->translate_string ("with"); pp_cxx_whitespace (pp); @@ -400,7 +402,10 @@ dump_template_bindings (cxx_pretty_printer *pp, tree parms, tree args, ~prepost_semicolon () { if (need_semicolon) - pp_cxx_right_bracket (pp); + { + pp_cxx_right_bracket (pp); + pp_string (pp, colorize_stop (pp_show_color (pp))); + } } } semicolon_or_introducer = {pp, false}; @@ -1170,6 +1175,22 @@ dump_simple_decl (cxx_pretty_printer *pp, tree t, tree type, int flags) dump_type_suffix (pp, type, flags); } +class colorize_guard +{ + bool colorize; + cxx_pretty_printer *pp; +public: + colorize_guard (bool _colorize, cxx_pretty_printer *pp, const char *name) + : colorize (_colorize && pp_show_color (pp)), pp (pp) + { + pp_string (pp, colorize_start (colorize, name)); + } + ~colorize_guard () + { + pp_string (pp, colorize_stop (colorize)); + } +}; + /* Print an IDENTIFIER_NODE that is the name of a declaration. */ static void @@ -1946,6 +1967,13 @@ dump_exception_spec (cxx_pretty_printer *pp, tree t, int flags) static void dump_function_name (cxx_pretty_printer *pp, tree t, int flags) { + /* Only colorize when we're printing something before the name; in + particular, not when printing a CALL_EXPR. */ + bool colorize = flags & (TFF_DECL_SPECIFIERS | TFF_RETURN_TYPE + | TFF_TEMPLATE_HEADER); + + colorize_guard g (colorize, pp, "fnname"); + tree name = DECL_NAME (t); /* We can get here with a decl that was synthesized by language- @@ -3088,6 +3116,7 @@ reinit_cxx_pp (void) cxx_pp->padding = pp_none; pp_indentation (cxx_pp) = 0; pp_needs_newline (cxx_pp) = false; + pp_show_color (cxx_pp) = false; cxx_pp->enclosing_scope = current_function_decl; } @@ -3234,7 +3263,7 @@ location_of (tree t) function. */ static const char * -decl_to_string (tree decl, int verbose) +decl_to_string (tree decl, int verbose, bool show_color) { int flags = 0; @@ -3248,6 +3277,7 @@ decl_to_string (tree decl, int verbose) flags |= TFF_TEMPLATE_HEADER; reinit_cxx_pp (); + pp_show_color (cxx_pp) = show_color; dump_decl (cxx_pp, decl, flags); return pp_ggc_formatted_text (cxx_pp); } @@ -3347,6 +3377,7 @@ type_to_string (tree typ, int verbose, bool postprocessed, bool *quote, flags |= TFF_TEMPLATE_HEADER; reinit_cxx_pp (); + pp_show_color (cxx_pp) = show_color; if (postprocessed && quote && *quote) pp_begin_quote (cxx_pp, show_color); @@ -3441,7 +3472,7 @@ args_to_string (tree p, int verbose) arguments. */ static const char * -subst_to_string (tree p) +subst_to_string (tree p, bool show_color) { tree decl = TREE_PURPOSE (p); tree targs = TREE_VALUE (p); @@ -3453,6 +3484,7 @@ subst_to_string (tree p) return ""; reinit_cxx_pp (); + pp_show_color (cxx_pp) = show_color; dump_template_decl (cxx_pp, TREE_PURPOSE (p), flags); dump_substitution (cxx_pp, NULL, tparms, targs, /*flags=*/0); return pp_ggc_formatted_text (cxx_pp); @@ -4420,7 +4452,7 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec, break; } } - result = decl_to_string (temp, verbose); + result = decl_to_string (temp, verbose, pp_show_color (pp)); } break; case 'E': result = expr_to_string (next_tree); break; @@ -4437,7 +4469,7 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec, case 'O': result = op_to_string (false, next_tcode); break; case 'P': result = parm_to_string (next_int); break; case 'Q': result = op_to_string (true, next_tcode); break; - case 'S': result = subst_to_string (next_tree); break; + case 'S': result = subst_to_string (next_tree, pp_show_color (pp)); break; case 'T': { result = type_to_string (next_tree, verbose, false, quoted, diff --git a/gcc/cp/init.cc b/gcc/cp/init.cc index 75ab965..f1ed933 100644 --- a/gcc/cp/init.cc +++ b/gcc/cp/init.cc @@ -422,7 +422,7 @@ build_value_init_noctor (tree type, tsubst_flags_t complain) && !COMPLETE_TYPE_P (ftype) && !TYPE_DOMAIN (ftype) && COMPLETE_TYPE_P (TREE_TYPE (ftype)) - && (next_initializable_field (DECL_CHAIN (field)) + && (next_aggregate_field (DECL_CHAIN (field)) == NULL_TREE)) continue; @@ -1477,9 +1477,9 @@ emit_mem_initializers (tree mem_inits) /* Initially that is all of them. */ if (warn_uninitialized) - for (tree f = next_initializable_field (TYPE_FIELDS (current_class_type)); + for (tree f = next_aggregate_field (TYPE_FIELDS (current_class_type)); f != NULL_TREE; - f = next_initializable_field (DECL_CHAIN (f))) + f = next_aggregate_field (DECL_CHAIN (f))) if (!DECL_ARTIFICIAL (f) && !is_really_empty_class (TREE_TYPE (f), /*ignore_vptr*/false)) uninitialized.add (f); diff --git a/gcc/cp/lambda.cc b/gcc/cp/lambda.cc index afac53b..3fb98a9 100644 --- a/gcc/cp/lambda.cc +++ b/gcc/cp/lambda.cc @@ -425,9 +425,9 @@ build_capture_proxy (tree member, tree init) if (DECL_VLA_CAPTURE_P (member)) { /* Rebuild the VLA type from the pointer and maxindex. */ - tree field = next_initializable_field (TYPE_FIELDS (type)); + tree field = next_aggregate_field (TYPE_FIELDS (type)); tree ptr = build_simple_component_ref (object, field); - field = next_initializable_field (DECL_CHAIN (field)); + field = next_aggregate_field (DECL_CHAIN (field)); tree max = build_simple_component_ref (object, field); type = build_cplus_array_type (TREE_TYPE (TREE_TYPE (ptr)), build_index_type (max)); @@ -1431,7 +1431,7 @@ record_lambda_scope (tree lambda) { tree closure = LAMBDA_EXPR_CLOSURE (lambda); gcc_checking_assert (closure); - maybe_attach_decl (lambda_scope, TYPE_NAME (closure)); + maybe_key_decl (lambda_scope, TYPE_NAME (closure)); } } diff --git a/gcc/cp/lex.cc b/gcc/cp/lex.cc index 739f089..784debc 100644 --- a/gcc/cp/lex.cc +++ b/gcc/cp/lex.cc @@ -1008,8 +1008,8 @@ cxx_dup_lang_specific_decl (tree node) (module_purview_p still does). */ ld->u.base.module_entity_p = false; ld->u.base.module_import_p = false; - ld->u.base.module_attached_p = false; - + ld->u.base.module_keyed_decls_p = false; + if (GATHER_STATISTICS) { tree_node_counts[(int)lang_decl] += 1; diff --git a/gcc/cp/method.cc b/gcc/cp/method.cc index 903ee66..0dffd64 100644 --- a/gcc/cp/method.cc +++ b/gcc/cp/method.cc @@ -1465,7 +1465,7 @@ build_comparison_op (tree fndecl, bool defining, tsubst_flags_t complain) /* A defaulted comparison operator function for class C is defined as deleted if ... C has variant members. */ if (TREE_CODE (ctype) == UNION_TYPE - && next_initializable_field (TYPE_FIELDS (ctype))) + && next_aggregate_field (TYPE_FIELDS (ctype))) { if (complain & tf_error) inform (info.loc, "cannot default compare union %qT", ctype); @@ -1518,9 +1518,9 @@ build_comparison_op (tree fndecl, bool defining, tsubst_flags_t complain) } /* Now compare the field subobjects. */ - for (tree field = next_initializable_field (TYPE_FIELDS (ctype)); + for (tree field = next_aggregate_field (TYPE_FIELDS (ctype)); field; - field = next_initializable_field (DECL_CHAIN (field))) + field = next_aggregate_field (DECL_CHAIN (field))) { if (DECL_VIRTUAL_P (field) || DECL_FIELD_IS_BASE (field)) /* We ignore the vptr, and we already handled bases. */ @@ -1542,7 +1542,7 @@ build_comparison_op (tree fndecl, bool defining, tsubst_flags_t complain) continue; } else if (ANON_UNION_TYPE_P (expr_type) - && next_initializable_field (TYPE_FIELDS (expr_type))) + && next_aggregate_field (TYPE_FIELDS (expr_type))) { if (complain & tf_error) inform (field_loc, "cannot default compare " diff --git a/gcc/cp/module.cc b/gcc/cp/module.cc index 18dabfc..6126316 100644 --- a/gcc/cp/module.cc +++ b/gcc/cp/module.cc @@ -2697,11 +2697,11 @@ pending_map_t *pending_table; completed. */ vec<tree, va_heap, vl_embed> *post_load_decls; -/* Some entities are attached to another entitity for ODR purposes. +/* Some entities are keyed to another entitity for ODR purposes. For example, at namespace scope, 'inline auto var = []{};', that - lambda is attached to 'var', and follows its ODRness. */ -typedef hash_map<tree, auto_vec<tree>> attached_map_t; -static attached_map_t *attached_table; + lambda is keyed to 'var', and follows its ODRness. */ +typedef hash_map<tree, auto_vec<tree>> keyed_map_t; +static keyed_map_t *keyed_table; /********************************************************************/ /* Tree streaming. The tree streaming is very specific to the tree @@ -2766,7 +2766,7 @@ enum merge_kind MK_partial, MK_enum, /* Found by CTX, & 1stMemberNAME. */ - MK_attached, /* Found by attachee & index. */ + MK_keyed, /* Found by key & index. */ MK_friend_spec, /* Like named, but has a tmpl & args too. */ MK_local_friend, /* Found by CTX, index. */ @@ -5533,7 +5533,7 @@ trees_out::lang_decl_bools (tree t) that's the GM purview, so not what the importer will mean */ WB (lang->u.base.module_purview_p && !header_module_p ()); if (VAR_OR_FUNCTION_DECL_P (t)) - WB (lang->u.base.module_attached_p); + WB (lang->u.base.module_keyed_decls_p); switch (lang->u.base.selector) { default: @@ -5603,7 +5603,7 @@ trees_in::lang_decl_bools (tree t) RB (lang->u.base.dependent_init_p); RB (lang->u.base.module_purview_p); if (VAR_OR_FUNCTION_DECL_P (t)) - RB (lang->u.base.module_attached_p); + RB (lang->u.base.module_keyed_decls_p); switch (lang->u.base.selector) { default: @@ -7701,11 +7701,11 @@ trees_out::decl_value (tree decl, depset *dep) if (VAR_OR_FUNCTION_DECL_P (inner) && DECL_LANG_SPECIFIC (inner) - && DECL_MODULE_ATTACHMENTS_P (inner) + && DECL_MODULE_KEYED_DECLS_P (inner) && !is_key_order ()) { - /* Stream the attached entities. */ - auto *attach_vec = attached_table->get (inner); + /* Stream the keyed entities. */ + auto *attach_vec = keyed_table->get (inner); unsigned num = attach_vec->length (); if (streaming_p ()) u (num); @@ -7998,12 +7998,12 @@ trees_in::decl_value () if (VAR_OR_FUNCTION_DECL_P (inner) && DECL_LANG_SPECIFIC (inner) - && DECL_MODULE_ATTACHMENTS_P (inner)) + && DECL_MODULE_KEYED_DECLS_P (inner)) { /* Read and maybe install the attached entities. */ bool existed; - auto &set = attached_table->get_or_insert (STRIP_TEMPLATE (existing), - &existed); + auto &set = keyed_table->get_or_insert (STRIP_TEMPLATE (existing), + &existed); unsigned num = u (); if (is_new == existed) set_overrun (); @@ -10200,9 +10200,9 @@ trees_out::get_merge_kind (tree decl, depset *dep) = LAMBDA_EXPR_EXTRA_SCOPE (CLASSTYPE_LAMBDA_EXPR (TREE_TYPE (decl)))) if (TREE_CODE (scope) == VAR_DECL - && DECL_MODULE_ATTACHMENTS_P (scope)) + && DECL_MODULE_KEYED_DECLS_P (scope)) { - mk = MK_attached; + mk = MK_keyed; break; } @@ -10492,13 +10492,13 @@ trees_out::key_mergeable (int tag, merge_kind mk, tree decl, tree inner, } break; - case MK_attached: + case MK_keyed: { gcc_checking_assert (LAMBDA_TYPE_P (TREE_TYPE (inner))); tree scope = LAMBDA_EXPR_EXTRA_SCOPE (CLASSTYPE_LAMBDA_EXPR (TREE_TYPE (inner))); gcc_checking_assert (TREE_CODE (scope) == VAR_DECL); - auto *root = attached_table->get (scope); + auto *root = keyed_table->get (scope); unsigned ix = root->length (); /* If we don't find it, we'll write a really big number that the reader will ignore. */ @@ -10506,7 +10506,7 @@ trees_out::key_mergeable (int tag, merge_kind mk, tree decl, tree inner, if ((*root)[ix] == inner) break; - /* Use the attached-to decl as the 'name'. */ + /* Use the keyed-to decl as the 'name'. */ name = scope; key.index = ix; } @@ -10773,12 +10773,12 @@ trees_in::key_mergeable (int tag, merge_kind mk, tree decl, tree inner, gcc_unreachable (); case NAMESPACE_DECL: - if (mk == MK_attached) + if (mk == MK_keyed) { if (DECL_LANG_SPECIFIC (name) && VAR_OR_FUNCTION_DECL_P (name) - && DECL_MODULE_ATTACHMENTS_P (name)) - if (auto *set = attached_table->get (name)) + && DECL_MODULE_KEYED_DECLS_P (name)) + if (auto *set = keyed_table->get (name)) if (key.index < set->length ()) { existing = (*set)[key.index]; @@ -18566,10 +18566,10 @@ set_originating_module (tree decl, bool friend_p ATTRIBUTE_UNUSED) DECL_MODULE_EXPORT_P (decl) = true; } -/* DECL is attached to ROOT for odr purposes. */ +/* DECL is keyed to CTX for odr purposes. */ void -maybe_attach_decl (tree ctx, tree decl) +maybe_key_decl (tree ctx, tree decl) { if (!modules_p ()) return; @@ -18581,14 +18581,14 @@ maybe_attach_decl (tree ctx, tree decl) gcc_checking_assert (DECL_NAMESPACE_SCOPE_P (ctx)); - if (!attached_table) - attached_table = new attached_map_t (EXPERIMENT (1, 400)); + if (!keyed_table) + keyed_table = new keyed_map_t (EXPERIMENT (1, 400)); - auto &vec = attached_table->get_or_insert (ctx); + auto &vec = keyed_table->get_or_insert (ctx); if (!vec.length ()) { retrofit_lang_decl (ctx); - DECL_MODULE_ATTACHMENTS_P (ctx) = true; + DECL_MODULE_KEYED_DECLS_P (ctx) = true; } vec.safe_push (decl); } @@ -18898,8 +18898,8 @@ direct_import (module_state *import, cpp_reader *reader) if (import->loadedness < ML_LANGUAGE) { - if (!attached_table) - attached_table = new attached_map_t (EXPERIMENT (1, 400)); + if (!keyed_table) + keyed_table = new keyed_map_t (EXPERIMENT (1, 400)); import->read_language (true); } @@ -20004,9 +20004,9 @@ fini_modules () delete pending_table; pending_table = NULL; - /* Or any attachments -- Let it go! */ - delete attached_table; - attached_table = NULL; + /* Or any keys -- Let it go! */ + delete keyed_table; + keyed_table = NULL; /* Allow a GC, we've possibly made much data unreachable. */ ggc_collect (); diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 3ebaa41..a28e0e2 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -1454,7 +1454,7 @@ cp_ensure_no_omp_declare_simd (cp_parser *parser) static inline void cp_finalize_omp_declare_simd (cp_parser *parser, tree fndecl) { - if (__builtin_expect (parser->omp_declare_simd != NULL, 0)) + if (UNLIKELY (parser->omp_declare_simd != NULL)) { if (fndecl == error_mark_node) { @@ -22660,7 +22660,7 @@ cp_parser_init_declarator (cp_parser* parser, bool ok = (cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON) || cp_lexer_next_token_is (parser->lexer, CPP_COMMA)); cp_lexer_rollback_tokens (parser->lexer); - if (__builtin_expect (!ok, 0)) + if (UNLIKELY (!ok)) /* Not an init-declarator. */ return error_mark_node; } @@ -47196,7 +47196,7 @@ cp_parser_late_parsing_oacc_routine (cp_parser *parser, tree attrs) static void cp_finalize_oacc_routine (cp_parser *parser, tree fndecl, bool is_defn) { - if (__builtin_expect (parser->oacc_routine != NULL, 0)) + if (UNLIKELY (parser->oacc_routine != NULL)) { /* Keep going if we're in error reporting mode. */ if (parser->oacc_routine->error_seen diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index fe2608c..6e666c2 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -29586,7 +29586,7 @@ maybe_aggr_guide (tree tmpl, tree init, vec<tree,va_gc> *args) len; --len, field = DECL_CHAIN (field)) { - field = next_initializable_field (field); + field = next_aggregate_field (field); if (!field) return NULL_TREE; tree ftype = finish_decltype_type (field, true, complain); diff --git a/gcc/cp/tree.cc b/gcc/cp/tree.cc index ed0d0d2..633cc16 100644 --- a/gcc/cp/tree.cc +++ b/gcc/cp/tree.cc @@ -4852,8 +4852,8 @@ structural_type_p (tree t, bool explain) explain_non_literal_class (t); return false; } - for (tree m = next_initializable_field (TYPE_FIELDS (t)); m; - m = next_initializable_field (DECL_CHAIN (m))) + for (tree m = next_aggregate_field (TYPE_FIELDS (t)); m; + m = next_aggregate_field (DECL_CHAIN (m))) { if (TREE_PRIVATE (m) || TREE_PROTECTED (m)) { @@ -6119,6 +6119,25 @@ maybe_warn_zero_as_null_pointer_constant (tree expr, location_t loc) } return false; } + +/* FNDECL is a function declaration whose type may have been altered by + adding extra parameters such as this, in-charge, or VTT. When this + takes place, the positional arguments supplied by the user (as in the + 'format' attribute arguments) may refer to the wrong argument. This + function returns an integer indicating how many arguments should be + skipped. */ + +int +maybe_adjust_arg_pos_for_attribute (const_tree fndecl) +{ + if (!fndecl) + return 0; + int n = num_artificial_parms_for (fndecl); + /* The manual states that it's the user's responsibility to account + for the implicit this parameter. */ + return n > 0 ? n - 1 : 0; +} + /* Release memory we no longer need after parsing. */ void diff --git a/gcc/cp/typeck2.cc b/gcc/cp/typeck2.cc index 63d95c1..1d92310 100644 --- a/gcc/cp/typeck2.cc +++ b/gcc/cp/typeck2.cc @@ -606,7 +606,7 @@ split_nonconstant_init_1 (tree dest, tree init, bool last, : TYPE_FIELDS (type)); ; prev = DECL_CHAIN (prev)) { - prev = next_initializable_field (prev); + prev = next_aggregate_field (prev); if (prev == field_index) break; tree ptype = TREE_TYPE (prev); @@ -1304,7 +1304,7 @@ digest_init_r (tree type, tree init, int nested, int flags, the first element of d, which is the B base subobject. The base of type B is copy-initialized from the D temporary, causing object slicing. */ - tree field = next_initializable_field (TYPE_FIELDS (type)); + tree field = next_aggregate_field (TYPE_FIELDS (type)); if (field && DECL_FIELD_IS_BASE (field)) { if (warning_at (loc, 0, "initializing a base class of type %qT " diff --git a/gcc/diagnostic-color.cc b/gcc/diagnostic-color.cc index 640adfa..95047d7 100644 --- a/gcc/diagnostic-color.cc +++ b/gcc/diagnostic-color.cc @@ -91,6 +91,8 @@ static struct color_cap color_dict[] = { "locus", SGR_SEQ (COLOR_BOLD), 5, false }, { "quote", SGR_SEQ (COLOR_BOLD), 5, false }, { "path", SGR_SEQ (COLOR_BOLD COLOR_SEPARATOR COLOR_FG_CYAN), 4, false }, + { "fnname", SGR_SEQ (COLOR_BOLD COLOR_SEPARATOR COLOR_FG_GREEN), 6, false }, + { "targs", SGR_SEQ (COLOR_FG_MAGENTA), 5, false }, { "fixit-insert", SGR_SEQ (COLOR_FG_GREEN), 12, false }, { "fixit-delete", SGR_SEQ (COLOR_FG_RED), 12, false }, { "diff-filename", SGR_SEQ (COLOR_BOLD), 13, false }, diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 3f4d6f2..7a35d96 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -4845,7 +4845,7 @@ The default @env{GCC_COLORS} is error=01;31:warning=01;35:note=01;36:range1=32:range2=34:locus=01:\ quote=01:path=01;36:fixit-insert=32:fixit-delete=31:\ diff-filename=01:diff-hunk=32:diff-delete=31:diff-insert=32:\ -type-diff=01;32 +type-diff=01;32:fnname=01;32:targs=35 @end smallexample @noindent where @samp{01;31} is bold red, @samp{01;35} is bold magenta, @@ -4890,6 +4890,14 @@ SGR substring for location information, @samp{file:line} or @vindex quote GCC_COLORS @r{capability} SGR substring for information printed within quotes. +@item fnname= +@vindex fnname GCC_COLORS @r{capability} +SGR substring for names of C++ functions. + +@item targs= +@vindex targs GCC_COLORS @r{capability} +SGR substring for C++ function template parameter bindings. + @item fixit-insert= @vindex fixit-insert GCC_COLORS @r{capability} SGR substring for fix-it hints suggesting text to diff --git a/gcc/domwalk.cc b/gcc/domwalk.cc index 9d04cc2..d633088 100644 --- a/gcc/domwalk.cc +++ b/gcc/domwalk.cc @@ -144,13 +144,13 @@ cmp_bb_postorder (const void *a, const void *b, void *data) static void sort_bbs_postorder (basic_block *bbs, int n, int *bb_postorder) { - if (__builtin_expect (n == 2, true)) + if (LIKELY (n == 2)) { basic_block bb0 = bbs[0], bb1 = bbs[1]; if (bb_postorder[bb0->index] < bb_postorder[bb1->index]) bbs[0] = bb1, bbs[1] = bb0; } - else if (__builtin_expect (n == 3, true)) + else if (LIKELY (n == 3)) { basic_block bb0 = bbs[0], bb1 = bbs[1], bb2 = bbs[2]; if (bb_postorder[bb0->index] < bb_postorder[bb1->index]) @@ -1249,7 +1249,7 @@ clear_rhs_from_active_local_stores (void) static inline void set_position_unneeded (store_info *s_info, int pos) { - if (__builtin_expect (s_info->is_large, false)) + if (UNLIKELY (s_info->is_large)) { if (bitmap_set_bit (s_info->positions_needed.large.bmap, pos)) s_info->positions_needed.large.count++; @@ -1264,7 +1264,7 @@ set_position_unneeded (store_info *s_info, int pos) static inline void set_all_positions_unneeded (store_info *s_info) { - if (__builtin_expect (s_info->is_large, false)) + if (UNLIKELY (s_info->is_large)) { HOST_WIDE_INT width; if (s_info->width.is_constant (&width)) @@ -1287,7 +1287,7 @@ set_all_positions_unneeded (store_info *s_info) static inline bool any_positions_needed_p (store_info *s_info) { - if (__builtin_expect (s_info->is_large, false)) + if (UNLIKELY (s_info->is_large)) { HOST_WIDE_INT width; if (s_info->width.is_constant (&width)) @@ -1328,7 +1328,7 @@ all_positions_needed_p (store_info *s_info, poly_int64 start, || !width.is_constant (&const_width)) return false; - if (__builtin_expect (s_info->is_large, false)) + if (UNLIKELY (s_info->is_large)) { for (HOST_WIDE_INT i = const_start; i < const_start + const_width; ++i) if (bitmap_bit_p (s_info->positions_needed.large.bmap, i)) diff --git a/gcc/expmed.cc b/gcc/expmed.cc index ed39c88..41738c1 100644 --- a/gcc/expmed.cc +++ b/gcc/expmed.cc @@ -403,13 +403,13 @@ flip_storage_order (machine_mode mode, rtx x) return gen_rtx_CONCAT (mode, real, imag); } - if (__builtin_expect (reverse_storage_order_supported < 0, 0)) + if (UNLIKELY (reverse_storage_order_supported < 0)) check_reverse_storage_order_support (); if (!is_a <scalar_int_mode> (mode, &int_mode)) { if (FLOAT_MODE_P (mode) - && __builtin_expect (reverse_float_storage_order_supported < 0, 0)) + && UNLIKELY (reverse_float_storage_order_supported < 0)) check_reverse_float_storage_order_support (); if (!int_mode_for_size (GET_MODE_PRECISION (mode), 0).exists (&int_mode) diff --git a/gcc/genmatch.cc b/gcc/genmatch.cc index 2eda730..2b84b84 100644 --- a/gcc/genmatch.cc +++ b/gcc/genmatch.cc @@ -3358,9 +3358,9 @@ dt_simplify::gen_1 (FILE *f, int indent, bool gimple, operand *result) } if (s->kind == simplify::SIMPLIFY) - fprintf_indent (f, indent, "if (__builtin_expect (!dbg_cnt (match), 0)) goto %s;\n", fail_label); + fprintf_indent (f, indent, "if (UNLIKELY (!dbg_cnt (match))) goto %s;\n", fail_label); - fprintf_indent (f, indent, "if (__builtin_expect (dump_file && (dump_flags & TDF_FOLDING), 0)) " + fprintf_indent (f, indent, "if (UNLIKELY (dump_file && (dump_flags & TDF_FOLDING))) " "fprintf (dump_file, \"%s ", s->kind == simplify::SIMPLIFY ? "Applying pattern" : "Matching expression"); diff --git a/gcc/ggc-common.cc b/gcc/ggc-common.cc index 755d166..9d737d0 100644 --- a/gcc/ggc-common.cc +++ b/gcc/ggc-common.cc @@ -592,7 +592,7 @@ gt_pch_save (FILE *f) temporarily defined and then restoring previous state. */ int get_vbits = 0; size_t valid_size = state.ptrs[i]->size; - if (__builtin_expect (RUNNING_ON_VALGRIND, 0)) + if (UNLIKELY (RUNNING_ON_VALGRIND)) { if (vbits.length () < valid_size) vbits.safe_grow (valid_size, true); @@ -644,7 +644,7 @@ gt_pch_save (FILE *f) if (state.ptrs[i]->note_ptr_fn != gt_pch_p_S) memcpy (state.ptrs[i]->obj, this_object, state.ptrs[i]->size); #if defined ENABLE_VALGRIND_ANNOTATIONS && defined VALGRIND_GET_VBITS - if (__builtin_expect (get_vbits == 1, 0)) + if (UNLIKELY (get_vbits == 1)) { (void) VALGRIND_SET_VBITS (state.ptrs[i]->obj, vbits.address (), valid_size); diff --git a/gcc/go/gofrontend/MERGE b/gcc/go/gofrontend/MERGE index ef20a0a..3ec315f 100644 --- a/gcc/go/gofrontend/MERGE +++ b/gcc/go/gofrontend/MERGE @@ -1,4 +1,4 @@ -70ca85f08edf63f46c87d540fa99c45e2903edc2 +6a33e7e30c89edc12340dc470b44791bb1066feb The first line of this file holds the git revision number of the last merge done from the gofrontend repository. diff --git a/gcc/go/gofrontend/expressions.cc b/gcc/go/gofrontend/expressions.cc index 1b3b3bf..734ecb9 100644 --- a/gcc/go/gofrontend/expressions.cc +++ b/gcc/go/gofrontend/expressions.cc @@ -7671,8 +7671,7 @@ Expression::comparison(Translate_context* context, Type* result_type, && left_type->array_type()->length() == NULL) { Array_type* at = left_type->array_type(); - bool is_lvalue = false; - left = at->get_value_pointer(context->gogo(), left, is_lvalue); + left = at->get_value_pointer(context->gogo(), left); } else if (left_type->interface_type() != NULL) { @@ -9276,7 +9275,7 @@ Builtin_call_expression::flatten_append(Gogo* gogo, Named_object* function, Type* unsafe_ptr_type = Type::make_pointer_type(Type::make_void_type()); Expression* a1 = Expression::make_type_descriptor(element_type, loc); Expression* a2 = Expression::make_temporary_reference(s1tmp, loc); - a2 = slice_type->array_type()->get_value_pointer(gogo, a2, false); + a2 = slice_type->array_type()->get_value_pointer(gogo, a2); a2 = Expression::make_cast(unsafe_ptr_type, a2, loc); Expression* a3 = Expression::make_temporary_reference(l1tmp, loc); Expression* a4 = Expression::make_temporary_reference(c1tmp, loc); @@ -13848,9 +13847,8 @@ Array_index_expression::do_get_backend(Translate_context* context) } else { - Expression* valptr = - array_type->get_value_pointer(gogo, this->array_, - this->is_lvalue_); + Expression* valptr = array_type->get_value_pointer(gogo, + this->array_); Bexpression* ptr = valptr->get_backend(context); ptr = gogo->backend()->pointer_offset_expression(ptr, start, loc); @@ -13891,8 +13889,7 @@ Array_index_expression::do_get_backend(Translate_context* context) Bexpression* offset = gogo->backend()->conditional_expression(bfn, int_btype, cond, zero, start, loc); - Expression* valptr = array_type->get_value_pointer(gogo, this->array_, - this->is_lvalue_); + Expression* valptr = array_type->get_value_pointer(gogo, this->array_); Bexpression* val = valptr->get_backend(context); val = gogo->backend()->pointer_offset_expression(val, offset, loc); @@ -17266,6 +17263,8 @@ Composite_literal_expression::lower_map(Gogo* gogo, Named_object* function, Location location = this->location(); Unordered_map(unsigned int, std::vector<Expression*>) st; Unordered_map(unsigned int, std::vector<Expression*>) nt; + bool saw_false = false; + bool saw_true = false; if (this->vals_ != NULL) { if (!this->has_keys_) @@ -17300,6 +17299,7 @@ Composite_literal_expression::lower_map(Gogo* gogo, Named_object* function, continue; std::string sval; Numeric_constant nval; + bool bval; if ((*p)->string_constant_value(&sval)) // Check string keys. { unsigned int h = Gogo::hash_string(sval, 0); @@ -17373,6 +17373,19 @@ Composite_literal_expression::lower_map(Gogo* gogo, Named_object* function, mit->second.push_back(*p); } } + else if ((*p)->boolean_constant_value(&bval)) + { + if ((bval && saw_true) || (!bval && saw_false)) + { + go_error_at((*p)->location(), + "duplicate key in map literal"); + return Expression::make_error(location); + } + if (bval) + saw_true = true; + else + saw_false = true; + } } } diff --git a/gcc/go/gofrontend/expressions.h b/gcc/go/gofrontend/expressions.h index 92e8d8d..707c193 100644 --- a/gcc/go/gofrontend/expressions.h +++ b/gcc/go/gofrontend/expressions.h @@ -3055,7 +3055,7 @@ class Array_index_expression : public Expression Expression* end, Expression* cap, Location location) : Expression(EXPRESSION_ARRAY_INDEX, location), array_(array), start_(start), end_(end), cap_(cap), type_(NULL), - is_lvalue_(false), needs_bounds_check_(true), is_flattened_(false) + needs_bounds_check_(true), is_flattened_(false) { } // Return the array. @@ -3087,18 +3087,6 @@ class Array_index_expression : public Expression end() const { return this->end_; } - // Return whether this array index expression appears in an lvalue - // (left hand side of assignment) context. - bool - is_lvalue() const - { return this->is_lvalue_; } - - // Update this array index expression to indicate that it appears - // in a left-hand-side or lvalue context. - void - set_is_lvalue() - { this->is_lvalue_ = true; } - void set_needs_bounds_check(bool b) { this->needs_bounds_check_ = b; } @@ -3174,8 +3162,6 @@ class Array_index_expression : public Expression Expression* cap_; // The type of the expression. Type* type_; - // Whether expr appears in an lvalue context. - bool is_lvalue_; // Whether bounds check is needed. bool needs_bounds_check_; // Whether this has already been flattened. diff --git a/gcc/go/gofrontend/types.cc b/gcc/go/gofrontend/types.cc index 3de0bd3..ef65670 100644 --- a/gcc/go/gofrontend/types.cc +++ b/gcc/go/gofrontend/types.cc @@ -7815,7 +7815,7 @@ Array_type::finish_backend_element(Gogo* gogo) // Return an expression for a pointer to the values in ARRAY. Expression* -Array_type::get_value_pointer(Gogo*, Expression* array, bool is_lvalue) const +Array_type::get_value_pointer(Gogo*, Expression* array) const { if (this->length() != NULL) { @@ -7828,25 +7828,6 @@ Array_type::get_value_pointer(Gogo*, Expression* array, bool is_lvalue) const } // Slice. - - if (is_lvalue) - { - Temporary_reference_expression* tref = - array->temporary_reference_expression(); - Var_expression* ve = array->var_expression(); - if (tref != NULL) - { - tref = tref->copy()->temporary_reference_expression(); - tref->set_is_lvalue(); - array = tref; - } - else if (ve != NULL) - { - ve = new Var_expression(ve->named_object(), ve->location()); - array = ve; - } - } - return Expression::make_slice_info(array, Expression::SLICE_INFO_VALUE_POINTER, array->location()); diff --git a/gcc/go/gofrontend/types.h b/gcc/go/gofrontend/types.h index c55345a..6d72e09 100644 --- a/gcc/go/gofrontend/types.h +++ b/gcc/go/gofrontend/types.h @@ -2800,7 +2800,7 @@ class Array_type : public Type // Return an expression for the pointer to the values in an array. Expression* - get_value_pointer(Gogo*, Expression* array, bool is_lvalue) const; + get_value_pointer(Gogo*, Expression* array) const; // Return an expression for the length of an array with this type. Expression* diff --git a/gcc/match.pd b/gcc/match.pd index 6d691d3..1fdd98b 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -1087,7 +1087,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (bit_ior:c (bit_xor:c@3 @0 @1) (bit_xor:c (bit_xor:c @1 @2) @0)) (bit_ior @3 @2)) -#if GIMPLE /* (~X | C) ^ D -> (X | C) ^ (~D ^ C) if (~D ^ C) can be simplified. */ (simplify (bit_xor:c (bit_ior:cs (bit_not:s @0) @1) @2) @@ -1104,7 +1103,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) && wi::bit_and_not (get_nonzero_bits (@0), wi::to_wide (@1)) == 0) (bit_xor @0 @1))) -#endif /* For constants M and N, if M == (1LL << cst) - 1 && (N & M) == M, ((A & N) + B) & M -> (A + B) & M @@ -1259,6 +1257,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && wi::to_wide (@1) != wi::min_value (TYPE_PRECISION (type), SIGNED)) (minus (plus @1 { build_minus_one_cst (type); }) @0)))) +#endif /* ~(X >> Y) -> ~X >> Y if ~X can be simplified. */ (simplify @@ -1271,7 +1270,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (!wi::neg_p (tree_nonzero_bits (@0))) (with { tree stype = signed_type_for (TREE_TYPE (@0)); } (convert (rshift (bit_not! (convert:stype @0)) @1)))))) -#endif /* x + (x & 1) -> (x + 1) & ~1 */ (simplify @@ -2750,7 +2748,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* (T)(A) +- (T)(B) -> (T)(A +- B) only when (A +- B) could be simplified to a simple value. */ -#if GIMPLE (for op (plus minus) (simplify (op (convert @0) (convert @1)) @@ -2761,7 +2758,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && !TYPE_OVERFLOW_TRAPS (type) && !TYPE_OVERFLOW_SANITIZED (type)) (convert (op! @0 @1))))) -#endif /* ~A + A -> -1 */ (simplify @@ -2947,9 +2943,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* If @1 +- @2 is constant require a hard single-use on either original operand (but not on both). */ (mult (plusminus @1 @2) @0) -#if GIMPLE (mult! (plusminus @1 @2) @0) -#endif ))) /* We cannot generate constant 1 for fract. */ (if (!ALL_FRACT_MODE_P (TYPE_MODE (type))) @@ -4070,7 +4064,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (integer_zerop (@0)) @2))) -#if GIMPLE /* Sink unary operations to branches, but only if we do fold both. */ (for op (negate bit_not abs absu) (simplify @@ -4093,7 +4086,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (op @3 (vec_cond:s @0 @1 @2)) (vec_cond @0 (op! @3 @1) (op! @3 @2)))) -#endif #if GIMPLE (match (nop_atomic_bit_test_and_p @0 @1 @4) @@ -5419,7 +5411,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (cmp:c (bit_xor:c @0 @1) @0) (cmp @1 { build_zero_cst (TREE_TYPE (@1)); })) -#if GIMPLE /* (X & Y) == X becomes (X & ~Y) == 0. */ (simplify (cmp:c (bit_and:c @0 @1) @0) @@ -5439,7 +5430,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (simplify (cmp:c (bit_ior:c @0 @1) @1) (cmp (bit_and @0 (bit_not! @1)) { build_zero_cst (TREE_TYPE (@0)); })) -#endif /* (X ^ C1) op C2 can be rewritten as X op (C1 ^ C2). */ (simplify diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index 4c52886..e7818a9 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -195,6 +195,7 @@ static vec<gomp_task *> task_cpyfns; static void scan_omp (gimple_seq *, omp_context *); static tree scan_omp_1_op (tree *, int *, void *); +static bool omp_maybe_offloaded_ctx (omp_context *ctx); #define WALK_SUBSTMTS \ case GIMPLE_BIND: \ @@ -1154,6 +1155,15 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) || !integer_onep (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)) || OMP_CLAUSE_ALLOCATE_ALIGN (c) != NULL_TREE)) { + /* The allocate clauses that appear on a target construct or on + constructs in a target region must specify an allocator expression + unless a requires directive with the dynamic_allocators clause + is present in the same compilation unit. */ + if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) == NULL_TREE + && ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0) + && omp_maybe_offloaded_ctx (ctx)) + error_at (OMP_CLAUSE_LOCATION (c), "%<allocate%> clause must" + " specify an allocator here"); if (ctx->allocate_map == NULL) ctx->allocate_map = new hash_map<tree, tree>; tree val = integer_zero_node; @@ -3988,6 +3998,7 @@ omp_runtime_api_call (const_tree fndecl) "target_associate_ptr", "target_disassociate_ptr", "target_free", + "target_is_accessible", "target_is_present", "target_memcpy", "target_memcpy_rect", diff --git a/gcc/poly-int.h b/gcc/poly-int.h index 2bf9d98..d085544 100644 --- a/gcc/poly-int.h +++ b/gcc/poly-int.h @@ -1178,6 +1178,19 @@ lshift (const poly_int_pod<N, Ca> &a, const Cb &b) } } +/* Poly version of sext_hwi, with the same interface. */ + +template<unsigned int N, typename C> +inline poly_int<N, HOST_WIDE_INT> +sext_hwi (const poly_int<N, C> &a, unsigned int precision) +{ + poly_int_pod<N, HOST_WIDE_INT> r; + for (unsigned int i = 0; i < N; i++) + r.coeffs[i] = sext_hwi (a.coeffs[i], precision); + return r; +} + + /* Return true if a0 + a1 * x might equal b0 + b1 * x for some nonnegative integer x. */ diff --git a/gcc/print-rtl.cc b/gcc/print-rtl.cc index 636113d..60c8454 100644 --- a/gcc/print-rtl.cc +++ b/gcc/print-rtl.cc @@ -941,7 +941,7 @@ rtx_writer::print_rtx (const_rtx in_rtx) { #ifndef GENERATOR_FILE case MEM: - if (__builtin_expect (final_insns_dump_p, false)) + if (UNLIKELY (final_insns_dump_p)) fprintf (m_outfile, " ["); else fprintf (m_outfile, " [" HOST_WIDE_INT_PRINT_DEC, diff --git a/gcc/rtl-iter.h b/gcc/rtl-iter.h index 320657c..8ee0d39 100644 --- a/gcc/rtl-iter.h +++ b/gcc/rtl-iter.h @@ -114,7 +114,7 @@ inline generic_subrtx_iterator <T>::array_type::array_type () : heap (0) {} template <typename T> inline generic_subrtx_iterator <T>::array_type::~array_type () { - if (__builtin_expect (heap != 0, false)) + if (UNLIKELY (heap != 0)) free_array (*this); } @@ -172,7 +172,7 @@ generic_subrtx_iterator <T>::next () { /* Add the subrtxes of M_CURRENT. */ rtx_type x = T::get_rtx (m_current); - if (__builtin_expect (x != 0, true)) + if (LIKELY (x != 0)) { enum rtx_code code = GET_CODE (x); ssize_t count = m_bounds[code].count; @@ -180,12 +180,12 @@ generic_subrtx_iterator <T>::next () { /* Handle the simple case of a single "e" block that is known to fit into the current array. */ - if (__builtin_expect (m_end + count <= LOCAL_ELEMS + 1, true)) + if (LIKELY (m_end + count <= LOCAL_ELEMS + 1)) { /* Set M_CURRENT to the first subrtx and queue the rest. */ ssize_t start = m_bounds[code].start; rtunion_type *src = &x->u.fld[start]; - if (__builtin_expect (count > 2, false)) + if (UNLIKELY (count > 2)) m_base[m_end++] = T::get_value (src[2].rt_rtx); if (count > 1) m_base[m_end++] = T::get_value (src[1].rt_rtx); diff --git a/gcc/rtl-ssa/internals.inl b/gcc/rtl-ssa/internals.inl index a629c7c..b36a7f4 100644 --- a/gcc/rtl-ssa/internals.inl +++ b/gcc/rtl-ssa/internals.inl @@ -305,7 +305,7 @@ inline clobber_info::clobber_info (insn_info *insn, unsigned int regno) inline void clobber_info::update_group (clobber_group *group) { - if (__builtin_expect (m_group != group, 0)) + if (UNLIKELY (m_group != group)) m_group = group; } diff --git a/gcc/rtl-ssa/member-fns.inl b/gcc/rtl-ssa/member-fns.inl index eea20b9..25a8750 100644 --- a/gcc/rtl-ssa/member-fns.inl +++ b/gcc/rtl-ssa/member-fns.inl @@ -484,7 +484,7 @@ insn_info::operator< (const insn_info &other) const if (this == &other) return false; - if (__builtin_expect (m_point != other.m_point, 1)) + if (LIKELY (m_point != other.m_point)) return m_point < other.m_point; return slow_compare_with (other) < 0; @@ -514,7 +514,7 @@ insn_info::compare_with (const insn_info *other) const if (this == other) return 0; - if (__builtin_expect (m_point != other->m_point, 1)) + if (LIKELY (m_point != other->m_point)) // Assume that points remain in [0, INT_MAX]. return m_point - other->m_point; diff --git a/gcc/rtlanal.cc b/gcc/rtlanal.cc index c436c64..7c29682 100644 --- a/gcc/rtlanal.cc +++ b/gcc/rtlanal.cc @@ -131,7 +131,7 @@ generic_subrtx_iterator <T>::add_subrtxes_to_queue (array_type &array, enum rtx_code code = GET_CODE (x); const char *format = GET_RTX_FORMAT (code); size_t orig_end = end; - if (__builtin_expect (INSN_P (x), false)) + if (UNLIKELY (INSN_P (x))) { /* Put the pattern at the top of the queue, since that's what we're likely to want most. It also allows for the SEQUENCE @@ -140,7 +140,7 @@ generic_subrtx_iterator <T>::add_subrtxes_to_queue (array_type &array, if (format[i] == 'e') { value_type subx = T::get_value (x->u.fld[i].rt_rtx); - if (__builtin_expect (end < LOCAL_ELEMS, true)) + if (LIKELY (end < LOCAL_ELEMS)) base[end++] = subx; else base = add_single_to_queue (array, base, end++, subx); @@ -151,7 +151,7 @@ generic_subrtx_iterator <T>::add_subrtxes_to_queue (array_type &array, if (format[i] == 'e') { value_type subx = T::get_value (x->u.fld[i].rt_rtx); - if (__builtin_expect (end < LOCAL_ELEMS, true)) + if (LIKELY (end < LOCAL_ELEMS)) base[end++] = subx; else base = add_single_to_queue (array, base, end++, subx); @@ -160,7 +160,7 @@ generic_subrtx_iterator <T>::add_subrtxes_to_queue (array_type &array, { unsigned int length = GET_NUM_ELEM (x->u.fld[i].rt_rtvec); rtx *vec = x->u.fld[i].rt_rtvec->elem; - if (__builtin_expect (end + length <= LOCAL_ELEMS, true)) + if (LIKELY (end + length <= LOCAL_ELEMS)) for (unsigned int j = 0; j < length; j++) base[end++] = T::get_value (vec[j]); else @@ -2114,7 +2114,7 @@ rtx_properties::try_to_add_dest (const_rtx x, unsigned int flags) { /* If we have a PARALLEL, SET_DEST is a list of EXPR_LIST expressions, each of whose first operand is a register. */ - if (__builtin_expect (GET_CODE (x) == PARALLEL, 0)) + if (UNLIKELY (GET_CODE (x) == PARALLEL)) { for (int i = XVECLEN (x, 0) - 1; i >= 0; --i) if (rtx dest = XEXP (XVECEXP (x, 0, i), 0)) @@ -2159,7 +2159,7 @@ rtx_properties::try_to_add_dest (const_rtx x, unsigned int flags) return; } - if (__builtin_expect (REG_P (x), 1)) + if (LIKELY (REG_P (x))) { /* We want to keep sp alive everywhere - by making all writes to sp also use sp. */ diff --git a/gcc/rtlanal.h b/gcc/rtlanal.h index 9fd84a7..f23aac7 100644 --- a/gcc/rtlanal.h +++ b/gcc/rtlanal.h @@ -247,7 +247,7 @@ growing_rtx_properties<Base>::repeat (AddFn add) /* This retries if the storage happened to be exactly the right size, but that's expected to be a rare case and so isn't worth optimizing for. */ - if (__builtin_expect (this->ref_iter != this->ref_end, 1)) + if (LIKELY (this->ref_iter != this->ref_end)) break; this->grow (count); } @@ -313,7 +313,7 @@ inline vec_rtx_properties_base::vec_rtx_properties_base () inline vec_rtx_properties_base::~vec_rtx_properties_base () { - if (__builtin_expect (ref_begin != m_storage, 0)) + if (UNLIKELY (ref_begin != m_storage)) free (ref_begin); } diff --git a/gcc/simplify-rtx.cc b/gcc/simplify-rtx.cc index e152918..fa20665 100644 --- a/gcc/simplify-rtx.cc +++ b/gcc/simplify-rtx.cc @@ -414,7 +414,7 @@ simplify_replace_fn_rtx (rtx x, const_rtx old_rtx, rtvec vec, newvec; int i, j; - if (__builtin_expect (fn != NULL, 0)) + if (UNLIKELY (fn != NULL)) { newx = fn (x, old_rtx, data); if (newx) diff --git a/gcc/sort.cc b/gcc/sort.cc index a2b6444..87f8268 100644 --- a/gcc/sort.cc +++ b/gcc/sort.cc @@ -37,8 +37,6 @@ along with GCC; see the file COPYING3. If not see #include "system.h" -#define likely(cond) __builtin_expect ((cond), 1) - #ifdef __GNUC__ #define noinline __attribute__ ((__noinline__)) #else @@ -86,15 +84,15 @@ do { \ memcpy (&t0, e0 + OFFSET, sizeof (TYPE)); \ memcpy (&t1, e1 + OFFSET, sizeof (TYPE)); \ char *out = c->out + OFFSET; \ - if (likely (c->n == 3)) \ + if (LIKELY (c->n == 3)) \ memmove (out + 2*STRIDE, e2 + OFFSET, sizeof (TYPE));\ memcpy (out, &t0, sizeof (TYPE)); out += STRIDE; \ memcpy (out, &t1, sizeof (TYPE)); \ } while (0) - if (likely (c->size == sizeof (size_t))) + if (LIKELY (c->size == sizeof (size_t))) REORDER_23 (size_t, sizeof (size_t), 0); - else if (likely (c->size == sizeof (int))) + else if (LIKELY (c->size == sizeof (int))) REORDER_23 (int, sizeof (int), 0); else { @@ -119,7 +117,7 @@ do { \ memcpy (&t2, e2 + OFFSET, sizeof (TYPE)); \ memcpy (&t3, e3 + OFFSET, sizeof (TYPE)); \ char *out = c->out + OFFSET; \ - if (likely (c->n == 5)) \ + if (LIKELY (c->n == 5)) \ memmove (out + 4*STRIDE, e4 + OFFSET, sizeof (TYPE));\ memcpy (out, &t0, sizeof (TYPE)); out += STRIDE; \ memcpy (out, &t1, sizeof (TYPE)); out += STRIDE; \ @@ -127,9 +125,9 @@ do { \ memcpy (out, &t3, sizeof (TYPE)); \ } while (0) - if (likely (c->size == sizeof (size_t))) + if (LIKELY (c->size == sizeof (size_t))) REORDER_45 (size_t, sizeof (size_t), 0); - else if (likely(c->size == sizeof (int))) + else if (LIKELY (c->size == sizeof (int))) REORDER_45 (int, sizeof (int), 0); else { @@ -168,7 +166,7 @@ do { \ char *e0 = in, *e1 = e0 + c->size, *e2 = e1 + c->size; CMP (e0, e1); - if (likely (c->n == 3)) + if (LIKELY (c->n == 3)) { CMP (e1, e2); CMP (e0, e1); @@ -176,13 +174,13 @@ do { \ if (c->n <= 3) return reorder23 (c, e0, e1, e2); char *e3 = e2 + c->size, *e4 = e3 + c->size; - if (likely (c->n == 5)) + if (LIKELY (c->n == 5)) { CMP (e3, e4); CMP (e2, e4); } CMP (e2, e3); - if (likely (c->n == 5)) + if (LIKELY (c->n == 5)) { CMP (e0, e3); CMP (e1, e4); @@ -200,7 +198,7 @@ template<typename sort_ctx> static void mergesort (char *in, sort_ctx *c, size_t n, char *out, char *tmp) { - if (likely (n <= c->nlim)) + if (LIKELY (n <= c->nlim)) { c->out = out; c->n = n; @@ -225,12 +223,12 @@ do { \ l += ~mr & SIZE; \ } while (r != end) - if (likely (c->cmp(r, l + (r - out) - c->size) < 0)) + if (LIKELY (c->cmp (r, l + (r - out) - c->size) < 0)) { char *end = out + n * c->size; - if (sizeof (size_t) == 8 && likely (c->size == 8)) + if (sizeof (size_t) == 8 && LIKELY (c->size == 8)) MERGE_ELTSIZE (8); - else if (likely (c->size == 4)) + else if (LIKELY (c->size == 4)) MERGE_ELTSIZE (4); else MERGE_ELTSIZE (c->size); diff --git a/gcc/system.h b/gcc/system.h index c5562cc..1c783c5 100644 --- a/gcc/system.h +++ b/gcc/system.h @@ -736,6 +736,9 @@ extern int vsnprintf (char *, size_t, const char *, va_list); #define __builtin_expect(a, b) (a) #endif +#define LIKELY(x) (__builtin_expect ((x), 1)) +#define UNLIKELY(x) (__builtin_expect ((x), 0)) + /* Some of the headers included by <memory> can use "abort" within a namespace, e.g. "_VSTD::abort();", which fails after we use the preprocessor to redefine "abort" as "fancy_abort" below. */ @@ -783,7 +786,7 @@ extern void fancy_abort (const char *, int, const char *) ((void)(!(EXPR) ? fancy_abort (__FILE__, __LINE__, __FUNCTION__), 0 : 0)) #elif (GCC_VERSION >= 4005) #define gcc_assert(EXPR) \ - ((void)(__builtin_expect (!(EXPR), 0) ? __builtin_unreachable (), 0 : 0)) + ((void)(UNLIKELY (!(EXPR)) ? __builtin_unreachable (), 0 : 0)) #else /* Include EXPR, so that unused variable warnings do not occur. */ #define gcc_assert(EXPR) ((void)(0 && (EXPR))) @@ -832,8 +835,7 @@ extern void fancy_abort (const char *, int, const char *) #define STATIC_CONSTANT_P(X) (false && (X)) #endif -/* static_assert (COND, MESSAGE) is available in C++11 onwards. */ -#if __cplusplus >= 201103L +#ifdef __cplusplus #define STATIC_ASSERT(X) \ static_assert ((X), #X) #else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4b7f49d..5d890c1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,28 @@ +2022-05-07 Marek Polacek <polacek@redhat.com> + + PR c++/101833 + PR c++/47634 + * g++.dg/ext/attr-format-arg1.C: New test. + * g++.dg/ext/attr-format1.C: New test. + * g++.dg/ext/attr-format2.C: New test. + * g++.dg/ext/attr-format3.C: New test. + +2022-05-06 Jason Merrill <jason@redhat.com> + + * g++.dg/diagnostic/function-color1.C: New test. + +2022-05-06 Michael Meissner <meissner@linux.ibm.com> + + PR target/102059 + * gcc.target/powerpc/pr102059-4.c: New test. + +2022-05-06 Hafiz Abid Qadeer <abidh@codesourcery.com> + + * c-c++-common/gomp/allocate-2.c: Add tests. + * c-c++-common/gomp/allocate-8.c: New test. + * gfortran.dg/gomp/allocate-3.f90: Add tests. + * gcc.dg/gomp/pr104517.c: Update. + 2022-05-05 Marek Polacek <polacek@redhat.com> PR c++/64679 diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-2.c b/gcc/testsuite/c-c++-common/gomp/allocate-2.c index cc77efc..6bb4a8a 100644 --- a/gcc/testsuite/c-c++-common/gomp/allocate-2.c +++ b/gcc/testsuite/c-c++-common/gomp/allocate-2.c @@ -43,3 +43,18 @@ foo (int x, int z) #pragma omp parallel private (x) allocate (0 : x) /* { dg-error "'allocate' clause allocator expression has type 'int' rather than 'omp_allocator_handle_t'" } */ bar (x, &x, 0); } + +void +foo1 () +{ + int a = 10; +#pragma omp target + { + #pragma omp parallel private (a) allocate(a) // { dg-error "'allocate' clause must specify an allocator here" } + a = 20; + } +#pragma omp target private(a) allocate(a) // { dg-error "'allocate' clause must specify an allocator here" } + { + a = 30; + } +} diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-8.c b/gcc/testsuite/c-c++-common/gomp/allocate-8.c new file mode 100644 index 0000000..bacefaf --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/allocate-8.c @@ -0,0 +1,18 @@ +#pragma omp requires dynamic_allocators +void +foo () +{ + int a = 10; +#pragma omp parallel private (a) allocate(a) + a = 20; +#pragma omp target + { + #pragma omp parallel private (a) allocate(a) + a = 30; + } +#pragma omp target private(a) allocate(a) + { + a = 40; + } +} + diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-union7.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-union7.C new file mode 100644 index 0000000..b3147d9 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-union7.C @@ -0,0 +1,17 @@ +// PR c++/105491 +// { dg-do compile { target c++11 } } + +struct V { + int m = 0; +}; +struct S : V { + constexpr S(int) : b() { } + bool b; +}; +struct W { + constexpr W() : s(0) { } + union { + S s; + }; +}; +constexpr W w; diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-union7a.C b/gcc/testsuite/g++.dg/cpp0x/constexpr-union7a.C new file mode 100644 index 0000000..b676e7d --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-union7a.C @@ -0,0 +1,15 @@ +// PR c++/105491 +// { dg-do compile { target c++11 } } + +struct V { + int m = 0; +}; +struct S : V { + constexpr S(int) : b() { } + bool b; +}; +union W { + constexpr W() : s(0) { } + S s; +}; +constexpr W w; diff --git a/gcc/testsuite/g++.dg/cpp2a/constinit17.C b/gcc/testsuite/g++.dg/cpp2a/constinit17.C new file mode 100644 index 0000000..6431654 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/constinit17.C @@ -0,0 +1,24 @@ +// PR c++/105491 +// { dg-do compile { target c++11 } } + +class Message { + virtual int GetMetadata(); +}; +class ProtobufCFileOptions : Message { +public: + constexpr ProtobufCFileOptions(int); + bool no_generate_; + bool const_strings_; + bool use_oneof_field_name_; + bool gen_pack_helpers_; + bool gen_init_helpers_; +}; +constexpr ProtobufCFileOptions::ProtobufCFileOptions(int) + : no_generate_(), const_strings_(), use_oneof_field_name_(), + gen_pack_helpers_(), gen_init_helpers_() {} +struct ProtobufCFileOptionsDefaultTypeInternal { + constexpr ProtobufCFileOptionsDefaultTypeInternal() : _instance({}) {} + union { + ProtobufCFileOptions _instance; + }; +} __constinit _ProtobufCFileOptions_default_instance_; diff --git a/gcc/testsuite/g++.dg/diagnostic/function-color1.C b/gcc/testsuite/g++.dg/diagnostic/function-color1.C new file mode 100644 index 0000000..32d9e966 --- /dev/null +++ b/gcc/testsuite/g++.dg/diagnostic/function-color1.C @@ -0,0 +1,21 @@ +// Verify colorization of printing of function declarations. +// Use dg-*-multiline-output to avoid regexp interpretation. + +// { dg-options "-fdiagnostics-color=always" } + +template <class T> void f(short t); +template <class T> void f(long t); + +int main() +{ + f<int>(42); + /* { dg-begin-multiline-output "" } +call of overloaded '[01m[Kf<int>(int)[m[K' is ambiguous + { dg-end-multiline-output "" } */ + /* { dg-begin-multiline-output "" } +candidate: '[01m[Kvoid[01;32m[K f[m[K(short int) [35m[K[with T = int][m[K[m[K' + { dg-end-multiline-output "" } */ +} + +// Discard the remaining colorized output that confuses dejagnu. +// { dg-prune-output diagnostic/function-color1.C } diff --git a/gcc/testsuite/g++.dg/ext/attr-format-arg1.C b/gcc/testsuite/g++.dg/ext/attr-format-arg1.C new file mode 100644 index 0000000..a7ad0f9 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/attr-format-arg1.C @@ -0,0 +1,26 @@ +// PR c++/101833 +// { dg-do compile } +// { dg-options "-Wall" } + +struct B { }; + +struct V : virtual B { + const char *fmt (int, const char *) __attribute__((format_arg(3))); +}; + +struct D : B { + const char *fmt (int, const char *) __attribute__((format_arg(3))); +}; + +extern void fmt (const char *, ...) __attribute__((format(printf, 1, 2))); + +void +g () +{ + V v; + fmt (v.fmt (1, "%d"), 1); + fmt (v.fmt (1, "%d"), 1lu); // { dg-warning "expects argument of type" } + D d; + fmt (d.fmt (1, "%d"), 1); + fmt (d.fmt (1, "%d"), 1lu); // { dg-warning "expects argument of type" } +} diff --git a/gcc/testsuite/g++.dg/ext/attr-format1.C b/gcc/testsuite/g++.dg/ext/attr-format1.C new file mode 100644 index 0000000..1b8464e --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/attr-format1.C @@ -0,0 +1,32 @@ +// PR c++/47634 +// { dg-do compile } + +class Base { +public: + Base() { } +}; + +class VDerived : public virtual Base { +public: + VDerived(int x, const char * f, ...) __attribute__((format(printf, 3, 4))); +}; + +class Derived : public Base { +public: + Derived(int x, const char * f, ...) __attribute__((format(printf, 3, 4))); +}; + +VDerived::VDerived(int, const char *, ...) +{ +} + +Derived::Derived(int, const char *, ...) +{ +} + +int +main(int, char **) +{ + throw VDerived(1, "%s %d", "foo", 1); + throw Derived(1, "%s %d", "bar", 1); +} diff --git a/gcc/testsuite/g++.dg/ext/attr-format2.C b/gcc/testsuite/g++.dg/ext/attr-format2.C new file mode 100644 index 0000000..7e6eec5 --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/attr-format2.C @@ -0,0 +1,38 @@ +// PR c++/101833 +// { dg-do compile } +// { dg-options "-Wall" } + +struct B { }; + +struct V : virtual B { + V(int, const char *, ...) __attribute__((format(printf, 3, 4))); +}; + +struct D : B { + D(int, const char *, ...) __attribute__((format(printf, 3, 4))); +}; + +struct D2 : B { + template<typename T> + D2(T, const char *, ...) __attribute__((format(printf, 3, 4))); +}; + +struct V2 : virtual B { + template<typename T> + V2(T, const char *, ...) __attribute__((format(printf, 3, 4))); +}; + +struct X { + template<typename T> + X(T, ...) __attribute__((format(printf, 2, 3))); +}; + +V v(1, "%s %d", "foo", 1); +D d(1, "%s %d", "foo", 1); +D2 d2(1, "%s %d", "foo", 1); +V2 v2(1, "%s %d", "foo", 1); + +// Test that it actually works. +V e1(1, "%d", 1L); // { dg-warning "expects argument of type" } +D e2(1, "%d", 1L); // { dg-warning "expects argument of type" } +X e3("%d", 1L); // { dg-warning "expects argument of type" } diff --git a/gcc/testsuite/g++.dg/ext/attr-format3.C b/gcc/testsuite/g++.dg/ext/attr-format3.C new file mode 100644 index 0000000..60a672c --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/attr-format3.C @@ -0,0 +1,15 @@ +// PR c++/101833 +// { dg-do compile } +// { dg-options "-Wall" } + +class Base {}; + +struct VDerived : virtual Base { + VDerived(int, int, const char *, ...) __attribute__((format(printf, 2, 3))); // { dg-error ".format. attribute argument 2 value .2. refers to parameter type .int." } + VDerived(int, const char *, ...) __attribute__((format(printf, 5, 6))); // { dg-warning ".format. attribute argument 2 value .5. exceeds" } +} a(1, "%s %d", "foo", 1); + +struct Derived : Base { + Derived(int, int, const char *, ...) __attribute__((format(printf, 2, 3))); // { dg-error ".format. attribute argument 2 value .2. refers to parameter type .int." } + Derived(int, const char *, ...) __attribute__((format(printf, 5, 6))); // { dg-warning ".format. attribute argument 2 value .5. exceeds" } +} b(1, "%s %d", "foo", 1); diff --git a/gcc/testsuite/gcc.dg/gomp/pr104517.c b/gcc/testsuite/gcc.dg/gomp/pr104517.c index efb3175..7e3bd1a 100644 --- a/gcc/testsuite/gcc.dg/gomp/pr104517.c +++ b/gcc/testsuite/gcc.dg/gomp/pr104517.c @@ -2,11 +2,13 @@ /* { dg-do compile } */ /* { dg-options "-O1 -fcompare-debug -fopenmp -fno-tree-ter -save-temps" } */ -enum { - omp_default_mem_alloc, - omp_large_cap_mem_alloc, - omp_const_mem_alloc, - omp_high_bw_mem_alloc +typedef enum omp_allocator_handle_t +{ + omp_null_allocator = 0, + omp_default_mem_alloc = 1, + omp_large_cap_mem_alloc = 2, + omp_const_mem_alloc = 3, + omp_high_bw_mem_alloc = 4, } omp_allocator_handle_t; int t, bar_nte, bar_tl, bar_i3, bar_dd; @@ -23,7 +25,7 @@ bar (int *idp, int s, int nth, int g, int nta, int fi, int pp, int *q, int p = 0, i2 = 0, i1 = 0, m = 0, d = 0; #pragma omp target parallel for \ - device(p) firstprivate (f) allocate (f) in_reduction(+:r2) + device(p) firstprivate (f) allocate (omp_default_mem_alloc:f) in_reduction(+:r2) for (int i = 0; i < 4; i++) ll++; @@ -31,8 +33,8 @@ bar (int *idp, int s, int nth, int g, int nta, int fi, int pp, int *q, device(d) map (m) \ if (target: p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) \ if (parallel: i2) reduction(+:r) num_threads (nth) linear (ll) \ - schedule(static) collapse(1) nowait depend(inout: d) allocate (f) \ - in_reduction(+:r2) + schedule(static) collapse(1) nowait depend(inout: d) \ + allocate (omp_default_mem_alloc:f) in_reduction(+:r2) for (int i = 0; i < 4; i++) ll++; diff --git a/gcc/testsuite/gcc.target/i386/pr105072.c b/gcc/testsuite/gcc.target/i386/pr105072.c new file mode 100644 index 0000000..54e2297 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105072.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ +/* { dg-options "-msse4.1 -O2" } */ +/* { dg-final { scan-assembler-times {(?n)pmovzxbq[ \t]+} "4" } } */ +/* { dg-final { scan-assembler-not {(?n)pinsrw[ \t]+} } } */ + +#include<immintrin.h> + +__m128i foo (void *p){ + return _mm_cvtepu8_epi64(_mm_loadu_si16(p)); +} + +__m128i foo2 (short a){ + return _mm_cvtepu8_epi64(_mm_set_epi16(0, 0, 0, 0, 0, 0, 0, a)); +} + +__m128i +foo3 (void *p){ + return _mm_cvtepu8_epi64((__m128i)__extension__(__m128h) {*(_Float16 const*)p, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f}); +} + +__m128i +foo4 (_Float16 a){ + return _mm_cvtepu8_epi64((__m128i)__extension__(__m128h) {a, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f}); +} diff --git a/gcc/testsuite/gcc.target/i386/pr105354-1.c b/gcc/testsuite/gcc.target/i386/pr105354-1.c new file mode 100644 index 0000000..8d91ded --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105354-1.c @@ -0,0 +1,130 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -msse2 -mno-ssse3" } */ +/* { dg-final { scan-assembler-times {(?n)psrldq[\t ]+} 16 } } */ +/* { dg-final { scan-assembler-times {(?n)pslldq[\t ]+} 16 } } */ +/* { dg-final { scan-assembler-times {(?n)por[\t ]+} 16 } } */ +/* { dg-final { scan-assembler-times {(?n)pandn[\t ]+} 8 } } */ +/* { dg-final { scan-assembler-times {(?n)pand[\t ]+} 8 } } */ + +typedef short v8hi __attribute__((vector_size (16))); +typedef char v16qi __attribute__((vector_size (16))); + +v16qi +__attribute__((noipa)) +foo (v16qi a, v16qi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 17, 18, 19, 20); +} + +v16qi +__attribute__((noipa)) +foo1 (v16qi a, v16qi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 18, 19, 20, 21, 22); +} + +v16qi +__attribute__((noipa)) +foo2 (v16qi a, v16qi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 16, 17, 18, 19, 20, 21); +} + +v16qi +__attribute__((noipa)) +foo3 (v16qi a, v16qi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 17, 18, 19, 20, 21, 22); +} + +v8hi +__attribute__((noipa)) +foo4 (v8hi a, v8hi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 8, 9, 10, 11, 12); +} + +v8hi +__attribute__((noipa)) +foo5 (v8hi a, v8hi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 7, 9, 10, 11, 12, 13); +} + +v8hi +__attribute__((noipa)) +foo6 (v8hi a, v8hi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 8, 9, 10, 11, 12, 13); +} + +v8hi +__attribute__((noipa)) +foo7 (v8hi a, v8hi b) +{ + return __builtin_shufflevector (a, b, 5, 6, 9, 10, 11, 12, 13, 14); +} + +v16qi +__attribute__((noipa)) +foo8 (v16qi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 17, 18, 19, 20); +} + +v16qi +__attribute__((noipa)) +foo9 (v16qi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 18, 19, 20, 21, 22); +} + +v16qi +__attribute__((noipa)) +foo10 (v16qi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 16, 17, 18, 19, 20, 21); +} + +v16qi +__attribute__((noipa)) +foo11 (v16qi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 17, 18, 19, 20, 21, 22); +} + +v8hi +__attribute__((noipa)) +foo12 (v8hi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 8, 9, 10, 11, 12); +} + +v8hi +__attribute__((noipa)) +foo13 (v8hi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 7, 9, 10, 11, 12, 13); +} + +v8hi +__attribute__((noipa)) +foo14 (v8hi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 8, 9, 10, 11, 12, 13); +} + +v8hi +__attribute__((noipa)) +foo15 (v8hi a) +{ + return __builtin_shufflevector (a, a, 5, 6, 9, 10, 11, 12, 13, 14); +} diff --git a/gcc/testsuite/gcc.target/i386/pr105354-2.c b/gcc/testsuite/gcc.target/i386/pr105354-2.c new file mode 100644 index 0000000..b78b62e --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr105354-2.c @@ -0,0 +1,110 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2 -mno-ssse3" } */ +/* { dg-require-effective-target sse2 } */ + +#include "sse2-check.h" + +#include "pr105354-1.c" +void +sse2_test (void) +{ + union128i_b a, b, res_ab, exp_ab; + union128i_w c, d, res_cd, exp_cd; + + for (int i = 0; i != 16;i++) + { + a.a[i] = i; + b.a[i] = i + 16; + res_ab.a[i] = 0; + exp_ab.a[i] = -1; + if (i <= 8) + { + c.a[i] = i; + d.a[i] = i + 8; + res_cd.a[i] = 0; + exp_cd.a[i] = -1; + } + } + + res_ab.x = (__m128i)foo ((v16qi)a.x, (v16qi)b.x); + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 }; + if (check_union128i_b (exp_ab, res_ab.a)) + abort (); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 18, 19, 20, 21, 22 }; + res_ab.x = (__m128i)foo1 ((v16qi)a.x, (v16qi)b.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 20, 21 }; + res_ab.x = (__m128i)foo2 ((v16qi)a.x, (v16qi)b.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 17, 18, 19, 20, 21, 22 }; + res_ab.x = (__m128i)foo3 ((v16qi)a.x, (v16qi)b.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + res_ab.x = (__m128i)foo8 ((v16qi)a.x); + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0, 1, 2, 3, 4 }; + if (check_union128i_b (exp_ab, res_ab.a)) + abort (); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 2, 3, 4, 5, 6 }; + res_ab.x = (__m128i)foo9 ((v16qi)a.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 0, 1, 2, 3, 4, 5 }; + res_ab.x = (__m128i)foo10 ((v16qi)a.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + exp_ab.x = __extension__(__m128i) (v16qi) { 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1, 2, 3, 4, 5, 6 }; + res_ab.x = (__m128i)foo11 ((v16qi)a.x); + if (check_union128i_b (exp_ab, res_ab.a)) + abort(); + + res_cd.x = (__m128i)foo4 ((v8hi)c.x, (v8hi)d.x); + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 7, 8, 9, 10, 11, 12 }; + if (check_union128i_w (exp_cd, res_cd.a)) + abort (); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 7, 9, 10, 11, 12, 13 }; + res_cd.x = (__m128i)foo5 ((v8hi)c.x, (v8hi)d.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 8, 9, 10, 11, 12, 13 }; + res_cd.x = (__m128i)foo6 ((v8hi)c.x, (v8hi)d.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + + res_cd.x = (__m128i)foo7 ((v8hi)c.x, (v8hi)d.x); + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 9, 10, 11, 12, 13, 14 }; + if (check_union128i_w (exp_cd, res_cd.a)) + abort (); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 7, 0, 1, 2, 3, 4 }; + res_cd.x = (__m128i)foo12 ((v8hi)c.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 7, 1, 2, 3, 4, 5 }; + res_cd.x = (__m128i)foo13 ((v8hi)c.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 0, 1, 2, 3, 4, 5 }; + res_cd.x = (__m128i)foo14 ((v8hi)c.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + + exp_cd.x = __extension__(__m128i) (v8hi) { 5, 6, 1, 2, 3, 4, 5, 6 }; + res_cd.x = (__m128i)foo15 ((v8hi)c.x); + if (check_union128i_w (exp_cd, res_cd.a)) + abort(); + +} + diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-1.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-1.c index 1ea6de8..818a56f 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-1.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-1.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=used" } */ +/* { dg-options "-O2 -fzero-call-used-regs=used -fno-stack-protector -fno-PIC" } */ void foo (void) diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-10.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-10.c index 389b114..01f6857 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-10.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-10.c @@ -11,11 +11,11 @@ foo (int x) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ -/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[\t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-13.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-13.c index 07d8de7..4ed036e 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-13.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-13.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=all -march=corei7" } */ +/* { dg-options "-O2 -fzero-call-used-regs=all -march=corei7 -msse" } */ void foo (void) @@ -7,15 +7,28 @@ foo (void) } /* { dg-final { scan-assembler-not "vzeroall" } } */ -/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm0, %xmm0" } } */ -/* { dg-final { scan-assembler-times "movaps\[ \t\]+%xmm0, %xmm\[0-9\]+" 7 { target { ia32 } } } } */ -/* { dg-final { scan-assembler-times "movaps\[ \t\]+%xmm0, %xmm\[0-9\]+" 15 { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm0, %xmm0" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm1, %xmm1" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm2, %xmm2" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm3, %xmm3" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm4, %xmm4" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm5, %xmm5" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm6, %xmm6" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm7, %xmm7" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm8, %xmm8" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm9, %xmm9" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm10, %xmm10" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm11, %xmm11" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm12, %xmm12" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm13, %xmm13" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm14, %xmm14" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm15, %xmm15" { target { ! ia32 } } } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-14.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-14.c index 55a272c..c361c0b 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-14.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-14.c @@ -9,11 +9,11 @@ foo (void) /* { dg-final { scan-assembler-times "vzeroall" 1 } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-15.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-15.c index d0e975c..4d45fa5 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-15.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-15.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=skip" } */ +/* { dg-options "-O2 -fzero-call-used-regs=skip -fno-stack-protector -fno-PIC" } */ extern void foo (void) __attribute__ ((zero_call_used_regs("used"))); diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-16.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-16.c index d41a255..fb5e6dd 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-16.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-16.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=all" } */ +/* { dg-options "-O2 -fzero-call-used-regs=all -fno-stack-protector -fno-PIC" } */ extern void foo (void) __attribute__ ((zero_call_used_regs("skip"))); diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-17.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-17.c index c79fcd3..10cfa12 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-17.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-17.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=used" } */ +/* { dg-options "-O2 -fzero-call-used-regs=used -fno-stack-protector" } */ int foo (int x) diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-18.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-18.c index 6f90723..0e399d4 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-18.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-18.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=used -march=corei7" } */ +/* { dg-options "-O2 -fzero-call-used-regs=used -march=corei7 -fno-stack-protector -fno-PIC" } */ float foo (float z, float y, float x) @@ -9,5 +9,5 @@ foo (float z, float y, float x) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler "pxor\[ \t\]+%xmm1, %xmm1" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm1, %xmm2" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm2, %xmm2" { target { ! ia32 } } } } */ /* { dg-final { scan-assembler-not "xorl\[ \t\]+%" } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-19.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-19.c index 491d2d5..cb0d5ebc 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-19.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-19.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=used -march=corei7" } */ +/* { dg-options "-O2 -fzero-call-used-regs=used -march=corei7 -fno-stack-protector -fno-PIC" } */ float foo (float z, float y, float x) diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-2.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-2.c index 52406fc..cb93209 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-2.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-2.c @@ -9,11 +9,11 @@ foo (void) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-20.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-20.c index ccd4917..123bd05 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-20.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-20.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=all -march=corei7" } */ +/* { dg-options "-O2 -fzero-call-used-regs=all -march=corei7 -msse" } */ float foo (float z, float y, float x) @@ -8,16 +8,28 @@ foo (float z, float y, float x) } /* { dg-final { scan-assembler-not "vzeroall" } } */ -/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm0, %xmm0" { target { ia32 } } } } */ -/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm1, %xmm1" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler-times "movaps\[ \t\]+%xmm0, %xmm\[0-9\]+" 7 { target { ia32 } } } } */ -/* { dg-final { scan-assembler-times "movaps\[ \t\]+%xmm1, %xmm\[0-9\]+" 14 { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm0, %xmm0" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm1, %xmm1" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm2, %xmm2" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm3, %xmm3" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm4, %xmm4" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm5, %xmm5" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm6, %xmm6" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm7, %xmm7" { target { ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm8, %xmm8" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm9, %xmm9" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm10, %xmm10" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm11, %xmm11" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm12, %xmm12" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm13, %xmm13" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm14, %xmm14" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm15, %xmm15" { target { ! ia32 } } } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-21.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-21.c index b3570f3..e8c3d9b 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-21.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-21.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=skip -march=corei7" } */ +/* { dg-options "-O2 -fzero-call-used-regs=skip -march=corei7 -fno-stack-protector -fno-PIC" } */ __attribute__ ((zero_call_used_regs("used"))) float @@ -10,5 +10,5 @@ foo (float z, float y, float x) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler "pxor\[ \t\]+%xmm1, %xmm1" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm1, %xmm2" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm2, %xmm2" { target { ! ia32 } } } } */ /* { dg-final { scan-assembler-not "xorl\[ \t\]+%" } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-22.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-22.c index b253420..63adbb9 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-22.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-22.c @@ -11,11 +11,11 @@ foo (void) /* { dg-final { scan-assembler-times "fstp\[ \t\]+%st\\(0\\)" 8 } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-23.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-23.c index 69d42d7..a3285be 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-23.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-23.c @@ -11,19 +11,19 @@ foo (void) /* { dg-final { scan-assembler-times "fstp\[ \t\]+%st\\(0\\)" 8 } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ /* { dg-final { scan-assembler "kxorw\[ \t\]+%k0, %k0, %k0" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k1" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k2" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k3" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k4" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k5" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k6" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "kmovw\[ \t\]+%k0, %k7" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k1, %k1, %k1" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k2, %k2, %k2" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k3, %k3, %k3" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k4, %k4, %k4" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k5, %k5, %k5" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k6, %k6, %k6" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "kxorw\[ \t\]+%k7, %k7, %k7" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-26.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-26.c index 8fb5299..3f22375 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-26.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-26.c @@ -8,16 +8,16 @@ foo (int x) } /* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "pxor\[ \t\]+%xmm0, %xmm0" } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm1" } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm2" } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm3" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm4" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm5" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm6" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movaps\[ \t\]+%xmm0, %xmm7" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm0, %xmm0" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm1, %xmm1" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm2, %xmm2" } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm3, %xmm3" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm4, %xmm4" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm5, %xmm5" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm6, %xmm6" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "\[a-z\]*xor\[a-z\]*\[ \t\]+%xmm7, %xmm7" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-27.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-27.c index 26ceacf..b307d10 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-27.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-27.c @@ -8,8 +8,8 @@ foo (int x) } /* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-28.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-28.c index 044e4af..dfa8e01 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-28.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-28.c @@ -10,9 +10,9 @@ __v2si ret_mmx (void) } /* { dg-final { scan-assembler "pxor\[ \t\]+%mm1, %mm1" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm2" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm3" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm4" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm5" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm6" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm7" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm2, %mm2" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm3, %mm3" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm4, %mm4" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm5, %mm5" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm6, %mm6" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm7, %mm7" } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-3.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-3.c index 89e69b8..6cd5c4c 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-3.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-3.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=skip" } */ +/* { dg-options "-O2 -fzero-call-used-regs=skip -fno-stack-protector" } */ void foo (void) diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-31.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-31.c index afa8b33..5a0e531 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-31.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-31.c @@ -10,5 +10,5 @@ __v2si ret_mmx (void) } /* { dg-final { scan-assembler "pxor\[ \t\]+%mm1, %mm1" } } */ -/* { dg-final { scan-assembler "movq\[ \t\]+%mm1, %mm2" } } */ -/* { dg-final { scan-assembler-not "movq\[ \t\]+%mm1, %mm\[34567\]" } } */ +/* { dg-final { scan-assembler "pxor\[ \t\]+%mm2, %mm2" } } */ +/* { dg-final { scan-assembler-not "pxor\[ \t\]+%mm\[34567\], %mm\[34567\]" } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-4.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-4.c index 1e98d17..becc5b8 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-4.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-4.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=skip" } */ +/* { dg-options "-O2 -fzero-call-used-regs=skip -fno-stack-protector -fno-PIC" } */ extern void foo (void) __attribute__ ((zero_call_used_regs("used-gpr"))); diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-5.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-5.c index 56aecda..4367f96 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-5.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-5.c @@ -10,11 +10,11 @@ foo (void) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%eax, %eax" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%eax, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-6.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-6.c index fa83185..88e3156 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-6.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-6.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=all-gpr" } */ +/* { dg-options "-O2 -fzero-call-used-regs=all-gpr -fno-stack-protector" } */ extern void foo (void) __attribute__ ((zero_call_used_regs("skip"))); diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-7.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-7.c index 0444a21..460c301e 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-7.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-7.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=used-gpr" } */ +/* { dg-options "-O2 -fzero-call-used-regs=used-gpr -fno-stack-protector" } */ int foo (int x) diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-8.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-8.c index 75356db..0eab769 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-8.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-8.c @@ -10,10 +10,10 @@ foo (int x) /* { dg-final { scan-assembler-not "vzeroall" } } */ /* { dg-final { scan-assembler-not "%xmm" } } */ /* { dg-final { scan-assembler "xorl\[ \t\]+%edx, %edx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %ecx" } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %esi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %edi" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r8d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r9d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r10d" { target { ! ia32 } } } } */ -/* { dg-final { scan-assembler "movl\[ \t\]+%edx, %r11d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%ecx, %ecx" } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%esi, %esi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%edi, %edi" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r8d, %r8d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r9d, %r9d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r10d, %r10d" { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler "xorl\[ \t\]+%r11d, %r11d" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-9.c b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-9.c index 64755b00..42dcaea 100644 --- a/gcc/testsuite/gcc.target/i386/zero-scratch-regs-9.c +++ b/gcc/testsuite/gcc.target/i386/zero-scratch-regs-9.c @@ -1,5 +1,5 @@ /* { dg-do compile { target *-*-linux* } } */ -/* { dg-options "-O2 -fzero-call-used-regs=skip" } */ +/* { dg-options "-O2 -fzero-call-used-regs=skip -fno-stack-protector" } */ extern int foo (int) __attribute__ ((zero_call_used_regs("used-gpr"))); diff --git a/gcc/testsuite/gcc.target/powerpc/pr102059-4.c b/gcc/testsuite/gcc.target/powerpc/pr102059-4.c new file mode 100644 index 0000000..5fe66f8 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/pr102059-4.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -mdejagnu-cpu=power10" } */ +/* { dg-require-effective-target power10_ok } */ + +/* Verify that power10 can explicity include functions compiled for power8. + The issue was -mcpu=power8 enables -mpower8-fusion, but -mcpu=power9 or + -mcpu=power10 do not set power8-fusion by default. Thus when doing this + compilation, they would get an error that the inline function failed in its + inlining due to having incompatible options. */ + +static inline int __attribute__ ((always_inline,target("cpu=power8"))) +foo (int *b) +{ + *b += 10; + return *b; +} + +int +bar (int *a) +{ + *a = foo (a); + return 0; +} diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 index 7b57be9..0bee99d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 @@ -12,3 +12,17 @@ subroutine foo(x) !$omp end parallel do simd end subroutine + +subroutine bar(a) + implicit none + integer :: a +!$omp target + !$omp parallel private (a) allocate(a) ! { dg-error "'allocate' clause must specify an allocator here" } + a = 20 + !$omp end parallel +!$omp end target + +!$omp target private(a) allocate(a) ! { dg-error "'allocate' clause must specify an allocator here" } + a = 30; +!$omp end target +end subroutine diff --git a/gcc/tree-core.h b/gcc/tree-core.h index c79b8b2..93258e3 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -2113,8 +2113,10 @@ struct attribute_spec { bool function_type_required; /* Specifies if attribute affects type's identity. */ bool affects_type_identity; - /* Function to handle this attribute. NODE points to the node to which - the attribute is to be applied. If a DECL, it should be modified in + /* Function to handle this attribute. NODE points to a tree[3] array, + where node[0] is the node to which the attribute is to be applied; + node[1] is the last pushed/merged declaration if one exists, and node[2] + may be the declaration for node[0]. If a DECL, it should be modified in place; if a TYPE, a copy should be created. NAME is the canonicalized name of the attribute i.e. without any leading or trailing underscores. ARGS is the TREE_LIST of the arguments (which may be NULL). FLAGS gives diff --git a/gcc/tree-ssa-sccvn.cc b/gcc/tree-ssa-sccvn.cc index 7658763..3732d06 100644 --- a/gcc/tree-ssa-sccvn.cc +++ b/gcc/tree-ssa-sccvn.cc @@ -3684,7 +3684,12 @@ vn_reference_lookup (tree op, tree vuse, vn_lookup_kind kind, break; off += vro->off; } - if (i == operands.length () - 1) + if (i == operands.length () - 1 + /* Make sure we the offset we accumulated in a 64bit int + fits the address computation carried out in target + offset precision. */ + && (off.coeffs[0] + == sext_hwi (off.coeffs[0], TYPE_PRECISION (sizetype)))) { gcc_assert (operands[i-1].opcode == MEM_REF); tree ops[2]; @@ -3808,7 +3813,12 @@ vn_reference_insert (tree op, tree result, tree vuse, tree vdef) break; off += vro->off; } - if (i == operands.length () - 1) + if (i == operands.length () - 1 + /* Make sure we the offset we accumulated in a 64bit int + fits the address computation carried out in target + offset precision. */ + && (off.coeffs[0] + == sext_hwi (off.coeffs[0], TYPE_PRECISION (sizetype)))) { gcc_assert (operands[i-1].opcode == MEM_REF); tree ops[2]; @@ -916,11 +916,11 @@ vec<T, A, vl_embed>::space (unsigned nelems) const } -/* Return iteration condition and update PTR to point to the IX'th +/* Return iteration condition and update *PTR to (a copy of) the IX'th element of this vector. Use this to iterate over the elements of a vector as follows, - for (ix = 0; vec<T, A>::iterate (v, ix, &ptr); ix++) + for (ix = 0; v->iterate (ix, &val); ix++) continue; */ template<typename T, typename A> diff --git a/gcc/wide-int.h b/gcc/wide-int.h index bd0d9a2..8041b61 100644 --- a/gcc/wide-int.h +++ b/gcc/wide-int.h @@ -1867,7 +1867,7 @@ wi::eq_p (const T1 &x, const T2 &y) while (++i != xi.len); return true; } - if (__builtin_expect (yi.len == 1, true)) + if (LIKELY (yi.len == 1)) { /* XI is only equal to YI if it too has a single HWI. */ if (xi.len != 1) @@ -1943,7 +1943,7 @@ wi::ltu_p (const T1 &x, const T2 &y) /* Optimize the case of two HWIs. The HWIs are implicitly sign-extended for precisions greater than HOST_BITS_WIDE_INT, but sign-extending both values does not change the result. */ - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { unsigned HOST_WIDE_INT xl = xi.to_uhwi (); unsigned HOST_WIDE_INT yl = yi.to_uhwi (); @@ -2114,7 +2114,7 @@ wi::cmpu (const T1 &x, const T2 &y) /* Optimize the case of two HWIs. The HWIs are implicitly sign-extended for precisions greater than HOST_BITS_WIDE_INT, but sign-extending both values does not change the result. */ - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { unsigned HOST_WIDE_INT xl = xi.to_uhwi (); unsigned HOST_WIDE_INT yl = yi.to_uhwi (); @@ -2321,7 +2321,7 @@ wi::bit_and (const T1 &x, const T2 &y) WIDE_INT_REF_FOR (T1) xi (x, precision); WIDE_INT_REF_FOR (T2) yi (y, precision); bool is_sign_extended = xi.is_sign_extended && yi.is_sign_extended; - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { val[0] = xi.ulow () & yi.ulow (); result.set_len (1, is_sign_extended); @@ -2342,7 +2342,7 @@ wi::bit_and_not (const T1 &x, const T2 &y) WIDE_INT_REF_FOR (T1) xi (x, precision); WIDE_INT_REF_FOR (T2) yi (y, precision); bool is_sign_extended = xi.is_sign_extended && yi.is_sign_extended; - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { val[0] = xi.ulow () & ~yi.ulow (); result.set_len (1, is_sign_extended); @@ -2363,7 +2363,7 @@ wi::bit_or (const T1 &x, const T2 &y) WIDE_INT_REF_FOR (T1) xi (x, precision); WIDE_INT_REF_FOR (T2) yi (y, precision); bool is_sign_extended = xi.is_sign_extended && yi.is_sign_extended; - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { val[0] = xi.ulow () | yi.ulow (); result.set_len (1, is_sign_extended); @@ -2384,7 +2384,7 @@ wi::bit_or_not (const T1 &x, const T2 &y) WIDE_INT_REF_FOR (T1) xi (x, precision); WIDE_INT_REF_FOR (T2) yi (y, precision); bool is_sign_extended = xi.is_sign_extended && yi.is_sign_extended; - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { val[0] = xi.ulow () | ~yi.ulow (); result.set_len (1, is_sign_extended); @@ -2405,7 +2405,7 @@ wi::bit_xor (const T1 &x, const T2 &y) WIDE_INT_REF_FOR (T1) xi (x, precision); WIDE_INT_REF_FOR (T2) yi (y, precision); bool is_sign_extended = xi.is_sign_extended && yi.is_sign_extended; - if (__builtin_expect (xi.len + yi.len == 2, true)) + if (LIKELY (xi.len + yi.len == 2)) { val[0] = xi.ulow () ^ yi.ulow (); result.set_len (1, is_sign_extended); @@ -2441,7 +2441,7 @@ wi::add (const T1 &x, const T2 &y) HOST_BITS_PER_WIDE_INT are relatively rare and there's not much point handling them inline. */ else if (STATIC_CONSTANT_P (precision > HOST_BITS_PER_WIDE_INT) - && __builtin_expect (xi.len + yi.len == 2, true)) + && LIKELY (xi.len + yi.len == 2)) { unsigned HOST_WIDE_INT xl = xi.ulow (); unsigned HOST_WIDE_INT yl = yi.ulow (); @@ -2527,7 +2527,7 @@ wi::sub (const T1 &x, const T2 &y) HOST_BITS_PER_WIDE_INT are relatively rare and there's not much point handling them inline. */ else if (STATIC_CONSTANT_P (precision > HOST_BITS_PER_WIDE_INT) - && __builtin_expect (xi.len + yi.len == 2, true)) + && LIKELY (xi.len + yi.len == 2)) { unsigned HOST_WIDE_INT xl = xi.ulow (); unsigned HOST_WIDE_INT yl = yi.ulow (); diff --git a/include/ansidecl.h b/include/ansidecl.h index 4275c9b..efee5b6 100644 --- a/include/ansidecl.h +++ b/include/ansidecl.h @@ -62,7 +62,6 @@ So instead we use the macro below and test it against specific values. */ #define GCC_VERSION (__GNUC__ * 1000 + __GNUC_MINOR__) #endif /* GCC_VERSION */ -#if defined (__STDC__) || defined(__cplusplus) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(_WIN32) /* All known AIX compilers implement these things (but don't always define __STDC__). The RISC/OS MIPS compiler defines these things in SVR4 mode, but does not define __STDC__. */ @@ -89,22 +88,6 @@ So instead we use the macro below and test it against specific values. */ # endif #endif -#else /* Not ANSI C. */ - -#define PTR char * - -/* some systems define these in header files for non-ansi mode */ -#undef const -#undef volatile -#undef signed -#undef inline -#define const -#define volatile -#define signed -#define inline - -#endif /* ANSI C. */ - /* Define macros for some gcc attributes. This permits us to use the macros freely, and know that they will come into play for the version of gcc in which they are supported. */ diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index 3011b37..b7e8322 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,15 @@ +2022-05-06 Marcel Vollweiler <marcel@codesourcery.com> + + * libgomp.map: Added omp_target_is_accessible. + * libgomp.texi: Tagged omp_target_is_accessible as supported. + * omp.h.in: Added omp_target_is_accessible. + * omp_lib.f90.in: Added interface for omp_target_is_accessible. + * omp_lib.h.in: Likewise. + * target.c (omp_target_is_accessible): Added implementation of + omp_target_is_accessible. + * testsuite/libgomp.c-c++-common/target-is-accessible-1.c: New test. + * testsuite/libgomp.fortran/target-is-accessible-1.f90: New test. + 2022-05-05 Sandra Loosemore <sandra@codesourcery.com> * libgomp.texi (OpenMP 5.0): Feature is now fully supported. diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map index 608a54c..d631a77 100644 --- a/libgomp/libgomp.map +++ b/libgomp/libgomp.map @@ -229,6 +229,7 @@ OMP_5.1 { OMP_5.1.1 { global: omp_get_mapped_ptr; + omp_target_is_accessible; } OMP_5.1; GOMP_1.0 { diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index 414cc50..b5e5fbb 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -311,7 +311,7 @@ The OpenMP 4.5 specification is fully supported. @item @code{omp_set_num_teams}, @code{omp_set_teams_thread_limit}, @code{omp_get_max_teams}, @code{omp_get_teams_thread_limit} runtime routines @tab Y @tab -@item @code{omp_target_is_accessible} runtime routine @tab N @tab +@item @code{omp_target_is_accessible} runtime routine @tab Y @tab @item @code{omp_target_memcpy_async} and @code{omp_target_memcpy_rect_async} runtime routines @tab N @tab @item @code{omp_get_mapped_ptr} runtime routine @tab Y @tab diff --git a/libgomp/omp.h.in b/libgomp/omp.h.in index 18d0152..f427f42 100644 --- a/libgomp/omp.h.in +++ b/libgomp/omp.h.in @@ -283,6 +283,8 @@ extern int omp_target_associate_ptr (const void *, const void *, __SIZE_TYPE__, __SIZE_TYPE__, int) __GOMP_NOTHROW; extern int omp_target_disassociate_ptr (const void *, int) __GOMP_NOTHROW; extern void *omp_get_mapped_ptr (const void *, int) __GOMP_NOTHROW; +extern int omp_target_is_accessible (const void *, __SIZE_TYPE__, int) + __GOMP_NOTHROW; extern void omp_set_affinity_format (const char *) __GOMP_NOTHROW; extern __SIZE_TYPE__ omp_get_affinity_format (char *, __SIZE_TYPE__) diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in index 506f15c..a2854a6 100644 --- a/libgomp/omp_lib.f90.in +++ b/libgomp/omp_lib.f90.in @@ -844,6 +844,16 @@ end function omp_get_mapped_ptr end interface + interface + function omp_target_is_accessible (ptr, size, device_num) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int + integer(c_int) :: omp_target_is_accessible + type(c_ptr), value :: ptr + integer(c_size_t), value :: size + integer(c_int), value :: device_num + end function omp_target_is_accessible + end interface + #if _OPENMP >= 201811 !GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested #endif diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in index 0f48510..2855433 100644 --- a/libgomp/omp_lib.h.in +++ b/libgomp/omp_lib.h.in @@ -425,3 +425,14 @@ integer(c_int), value :: device_num end function omp_get_mapped_ptr end interface + + interface + function omp_target_is_accessible (ptr, size, device_num) & + & bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int + integer(c_int) :: omp_target_is_accessible + type(c_ptr), value :: ptr + integer(c_size_t), value :: size + integer(c_int), value :: device_num + end function omp_target_is_accessible + end interface diff --git a/libgomp/target.c b/libgomp/target.c index 86930ea..4d62efd 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -3704,6 +3704,24 @@ omp_get_mapped_ptr (const void *ptr, int device_num) } int +omp_target_is_accessible (const void *ptr, size_t size, int device_num) +{ + if (device_num < 0 || device_num > gomp_get_num_devices ()) + return false; + + if (device_num == gomp_get_num_devices ()) + return true; + + struct gomp_device_descr *devicep = resolve_device (device_num); + if (devicep == NULL) + return false; + + /* TODO: Unified shared memory must be handled when available. */ + + return devicep->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM; +} + +int omp_pause_resource (omp_pause_resource_t kind, int device_num) { (void) kind; diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-is-accessible-1.c b/libgomp/testsuite/libgomp.c-c++-common/target-is-accessible-1.c new file mode 100644 index 0000000..7c2cf62 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/target-is-accessible-1.c @@ -0,0 +1,47 @@ +#include <omp.h> + +int +main () +{ + int d = omp_get_default_device (); + int id = omp_get_initial_device (); + int n = omp_get_num_devices (); + void *p; + + if (d < 0 || d >= n) + d = id; + + if (!omp_target_is_accessible (p, sizeof (int), n)) + __builtin_abort (); + + if (!omp_target_is_accessible (p, sizeof (int), id)) + __builtin_abort (); + + if (omp_target_is_accessible (p, sizeof (int), -1)) + __builtin_abort (); + + if (omp_target_is_accessible (p, sizeof (int), n + 1)) + __builtin_abort (); + + /* Currently, a host pointer is accessible if the device supports shared + memory or omp_target_is_accessible is executed on the host. This + test case must be adapted when unified shared memory is avialable. */ + int a[128]; + for (int d = 0; d <= omp_get_num_devices (); d++) + { + int shared_mem = 0; + #pragma omp target map (alloc: shared_mem) device (d) + shared_mem = 1; + if (omp_target_is_accessible (p, sizeof (int), d) != shared_mem) + __builtin_abort (); + + if (omp_target_is_accessible (a, 128 * sizeof (int), d) != shared_mem) + __builtin_abort (); + + for (int i = 0; i < 128; i++) + if (omp_target_is_accessible (&a[i], sizeof (int), d) != shared_mem) + __builtin_abort (); + } + + return 0; +} diff --git a/libgomp/testsuite/libgomp.fortran/target-is-accessible-1.f90 b/libgomp/testsuite/libgomp.fortran/target-is-accessible-1.f90 new file mode 100644 index 0000000..2611855 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-is-accessible-1.f90 @@ -0,0 +1,50 @@ +program main + use omp_lib + use iso_c_binding + implicit none (external, type) + integer :: d, id, n, shared_mem, i + integer, target :: a(1:128) + type(c_ptr) :: p + + d = omp_get_default_device () + id = omp_get_initial_device () + n = omp_get_num_devices () + + if (d < 0 .or. d >= n) & + d = id + + if (omp_target_is_accessible (p, c_sizeof (d), n) /= 1) & + stop 1 + + if (omp_target_is_accessible (p, c_sizeof (d), id) /= 1) & + stop 2 + + if (omp_target_is_accessible (p, c_sizeof (d), -1) /= 0) & + stop 3 + + if (omp_target_is_accessible (p, c_sizeof (d), n + 1) /= 0) & + stop 4 + + ! Currently, a host pointer is accessible if the device supports shared + ! memory or omp_target_is_accessible is executed on the host. This + ! test case must be adapted when unified shared memory is avialable. + do d = 0, omp_get_num_devices () + shared_mem = 0; + !$omp target map (alloc: shared_mem) device (d) + shared_mem = 1; + !$omp end target + + if (omp_target_is_accessible (p, c_sizeof (d), d) /= shared_mem) & + stop 5; + + if (omp_target_is_accessible (c_loc (a), 128 * sizeof (a(1)), d) /= shared_mem) & + stop 6; + + do i = 1, 128 + if (omp_target_is_accessible (c_loc (a(i)), sizeof (a(i)), d) /= shared_mem) & + stop 7; + end do + + end do + +end program main diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 700044a..e235ded 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,58 @@ +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/random.tcc (operator==): Only check + normal_distribution::_M_saved_available once. + * testsuite/26_numerics/random/normal_distribution/operators/equal.cc: + Check equality after state changes. + * testsuite/26_numerics/random/pr60037-neg.cc: Adjust dg-error + lineno. + +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + PR libstdc++/105502 + * include/bits/random.tcc + (operator>>(basic_istream<C,T>&, normal_distribution<R>&)): + Update state when __state_avail is false. + * testsuite/26_numerics/random/normal_distribution/operators/serialize.cc: + Check that deserialized object equals serialized one. + +2022-05-06 Alexandre Oliva <oliva@adacore.com> + + * include/experimental/bits/simd.h [__ALTIVEC__]: Require VSX + for double, long long, and 64-bit long intrinsic types. + [__ALTIVEC__] (__intrinsic_type): Mention 128-bit in + preexisting long double diagnostic, adjust no-VSX double + diagnostic to cover 64-bit long double as well. + +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + PR libstdc++/104731 + * testsuite/27_io/filesystem/iterators/error_reporting.cc: + Use a trailing char array as storage for dirent::d_name. + +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + * include/std/stacktrace: Do not include <cxxabi.h>. + (__cxa_demangle): Declare. + +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + PR libstdc++/99871 + * include/bits/specfun.h: Use visibility attribute on namespace, + instead of pragma push/pop. + * libsupc++/compare: Likewise. + * libsupc++/exception: Likewise. + * libsupc++/exception.h: Likewise. + * libsupc++/exception_ptr.h: Likewise. + * libsupc++/initializer_list: Likewise. + * libsupc++/nested_exception.h: Likewise. + +2022-05-06 Jonathan Wakely <jwakely@redhat.com> + + * doc/xml/manual/test.xml: Remove requirement for copyright and + GPL notice in tests. + * doc/html/manual/test.html: Regenerate. + 2022-05-05 Jonathan Wakely <jwakely@redhat.com> * include/experimental/memory_resource [!__cpp_rtti] diff --git a/libstdc++-v3/doc/html/manual/test.html b/libstdc++-v3/doc/html/manual/test.html index ef56a30..10ae4ed 100644 --- a/libstdc++-v3/doc/html/manual/test.html +++ b/libstdc++-v3/doc/html/manual/test.html @@ -371,8 +371,12 @@ cat 27_io/objects/char/3_xin.in | a.out</pre></dd><dt><span class="term"><code c directory and file name, given the organization as previously described. </p><p> - All files are copyright the FSF, and GPL'd: this is very - important. The first copyright year should correspond to the date + Historically all test files were copyright the FSF, and GPL licensed. + We no longer require that, because most tests are uninteresting + and contain no "original authorship", and so would not be protected + by copyright anyway. + If you do want to add the FSF copyright notice and GPL licence text, + then the first copyright year should correspond to the date the file was checked in to version control. If a test is copied from an existing file it should retain the copyright years from the original file. diff --git a/libstdc++-v3/doc/xml/manual/test.xml b/libstdc++-v3/doc/xml/manual/test.xml index ee00b06..7bc6e33 100644 --- a/libstdc++-v3/doc/xml/manual/test.xml +++ b/libstdc++-v3/doc/xml/manual/test.xml @@ -630,8 +630,12 @@ cat 27_io/objects/char/3_xin.in | a.out</programlisting> </para> <para> - All files are copyright the FSF, and GPL'd: this is very - important. The first copyright year should correspond to the date + Historically all test files were copyright the FSF, and GPL licensed. + We no longer require that, because most tests are uninteresting + and contain no "original authorship", and so would not be protected + by copyright anyway. + If you do want to add the FSF copyright notice and GPL licence text, + then the first copyright year should correspond to the date the file was checked in to version control. If a test is copied from an existing file it should retain the copyright years from the original file. diff --git a/libstdc++-v3/include/bits/random.tcc b/libstdc++-v3/include/bits/random.tcc index 6c72e99..cb1d367 100644 --- a/libstdc++-v3/include/bits/random.tcc +++ b/libstdc++-v3/include/bits/random.tcc @@ -1907,15 +1907,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { if (__d1._M_param == __d2._M_param && __d1._M_saved_available == __d2._M_saved_available) - { - if (__d1._M_saved_available - && __d1._M_saved == __d2._M_saved) - return true; - else if(!__d1._M_saved_available) - return true; - else - return false; - } + return __d1._M_saved_available ? __d1._M_saved == __d2._M_saved : true; else return false; } @@ -1961,7 +1953,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION bool __saved_avail; if (__is >> __mean >> __stddev >> __saved_avail) { - if (__saved_avail && (__is >> __x._M_saved)) + if (!__saved_avail || (__is >> __x._M_saved)) { __x._M_saved_available = __saved_avail; __x.param(param_type(__mean, __stddev)); diff --git a/libstdc++-v3/include/bits/specfun.h b/libstdc++-v3/include/bits/specfun.h index cac3502..a12b04b 100644 --- a/libstdc++-v3/include/bits/specfun.h +++ b/libstdc++-v3/include/bits/specfun.h @@ -30,8 +30,6 @@ #ifndef _GLIBCXX_BITS_SPECFUN_H #define _GLIBCXX_BITS_SPECFUN_H 1 -#pragma GCC visibility push(default) - #include <bits/c++config.h> #define __STDCPP_MATH_SPEC_FUNCS__ 201003L @@ -1385,6 +1383,4 @@ _GLIBCXX_END_NAMESPACE_VERSION } // namespace __gnu_cxx #endif // __STRICT_ANSI__ -#pragma GCC visibility pop - #endif // _GLIBCXX_BITS_SPECFUN_H diff --git a/libstdc++-v3/include/experimental/bits/simd.h b/libstdc++-v3/include/experimental/bits/simd.h index 82e9841..b0226fa 100644 --- a/libstdc++-v3/include/experimental/bits/simd.h +++ b/libstdc++-v3/include/experimental/bits/simd.h @@ -2430,17 +2430,23 @@ template <typename _Tp> template <> \ struct __intrinsic_type_impl<_Tp> { using type = __vector _Tp; } _GLIBCXX_SIMD_PPC_INTRIN(float); +#ifdef __VSX__ _GLIBCXX_SIMD_PPC_INTRIN(double); +#endif _GLIBCXX_SIMD_PPC_INTRIN(signed char); _GLIBCXX_SIMD_PPC_INTRIN(unsigned char); _GLIBCXX_SIMD_PPC_INTRIN(signed short); _GLIBCXX_SIMD_PPC_INTRIN(unsigned short); _GLIBCXX_SIMD_PPC_INTRIN(signed int); _GLIBCXX_SIMD_PPC_INTRIN(unsigned int); +#if defined __VSX__ || __SIZEOF_LONG__ == 4 _GLIBCXX_SIMD_PPC_INTRIN(signed long); _GLIBCXX_SIMD_PPC_INTRIN(unsigned long); +#endif +#ifdef __VSX__ _GLIBCXX_SIMD_PPC_INTRIN(signed long long); _GLIBCXX_SIMD_PPC_INTRIN(unsigned long long); +#endif #undef _GLIBCXX_SIMD_PPC_INTRIN template <typename _Tp, size_t _Bytes> @@ -2450,10 +2456,11 @@ template <typename _Tp, size_t _Bytes> static constexpr bool _S_is_ldouble = is_same_v<_Tp, long double>; // allow _Tp == long double with -mlong-double-64 static_assert(!(_S_is_ldouble && sizeof(long double) > sizeof(double)), - "no __intrinsic_type support for long double on PPC"); + "no __intrinsic_type support for 128-bit floating point on PowerPC"); #ifndef __VSX__ - static_assert(!is_same_v<_Tp, double>, - "no __intrinsic_type support for double on PPC w/o VSX"); + static_assert(!(is_same_v<_Tp, double> + || (_S_is_ldouble && sizeof(long double) == sizeof(double))), + "no __intrinsic_type support for 64-bit floating point on PowerPC w/o VSX"); #endif using type = typename __intrinsic_type_impl< diff --git a/libstdc++-v3/include/std/stacktrace b/libstdc++-v3/include/std/stacktrace index 98ce923..8e6c79a 100644 --- a/libstdc++-v3/include/std/stacktrace +++ b/libstdc++-v3/include/std/stacktrace @@ -38,7 +38,6 @@ #include <bits/stl_iterator.h> #include <bits/stl_uninitialized.h> #include <ext/numeric_traits.h> -#include <cxxabi.h> struct __glibcxx_backtrace_state; struct __glibcxx_backtrace_simple_data; @@ -70,6 +69,13 @@ __glibcxx_backtrace_syminfo(__glibcxx_backtrace_state*, uintptr_t addr, void*); } +namespace __cxxabiv1 +{ + extern "C" char* + __cxa_demangle(const char* __mangled_name, char* __output_buffer, + size_t* __length, int* __status); +} + namespace std _GLIBCXX_VISIBILITY(default) { _GLIBCXX_BEGIN_NAMESPACE_VERSION diff --git a/libstdc++-v3/libsupc++/compare b/libstdc++-v3/libsupc++/compare index e9cf913..066867e 100644 --- a/libstdc++-v3/libsupc++/compare +++ b/libstdc++-v3/libsupc++/compare @@ -34,15 +34,13 @@ #if __cplusplus > 201703L && __cpp_impl_three_way_comparison >= 201907L -#pragma GCC visibility push(default) - #include <concepts> #if __cpp_lib_concepts # define __cpp_lib_three_way_comparison 201907L #endif -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { // [cmp.categories], comparison category types @@ -1239,8 +1237,6 @@ namespace std #endif // concepts } // namespace std -#pragma GCC visibility pop - #endif // C++20 #endif // _COMPARE diff --git a/libstdc++-v3/libsupc++/exception b/libstdc++-v3/libsupc++/exception index ae2b0dd..24c9129 100644 --- a/libstdc++-v3/libsupc++/exception +++ b/libstdc++-v3/libsupc++/exception @@ -32,14 +32,12 @@ #pragma GCC system_header -#pragma GCC visibility push(default) - #include <bits/c++config.h> #include <bits/exception.h> extern "C++" { -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { /** @addtogroup exceptions * @{ @@ -135,7 +133,7 @@ namespace std /// @} group exceptions } // namespace std -namespace __gnu_cxx +namespace __gnu_cxx _GLIBCXX_VISIBILITY(default) { _GLIBCXX_BEGIN_NAMESPACE_VERSION @@ -162,8 +160,6 @@ _GLIBCXX_END_NAMESPACE_VERSION } // extern "C++" -#pragma GCC visibility pop - #if (__cplusplus >= 201103L) #include <bits/exception_ptr.h> #include <bits/nested_exception.h> diff --git a/libstdc++-v3/libsupc++/exception.h b/libstdc++-v3/libsupc++/exception.h index 7d90518..1df02bd 100644 --- a/libstdc++-v3/libsupc++/exception.h +++ b/libstdc++-v3/libsupc++/exception.h @@ -33,13 +33,11 @@ #pragma GCC system_header -#pragma GCC visibility push(default) - #include <bits/c++config.h> extern "C++" { -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { /** * @defgroup exceptions Exceptions @@ -82,6 +80,4 @@ namespace std } -#pragma GCC visibility pop - #endif diff --git a/libstdc++-v3/libsupc++/exception_ptr.h b/libstdc++-v3/libsupc++/exception_ptr.h index 6433f05..21c53f6 100644 --- a/libstdc++-v3/libsupc++/exception_ptr.h +++ b/libstdc++-v3/libsupc++/exception_ptr.h @@ -31,8 +31,6 @@ #ifndef _EXCEPTION_PTR_H #define _EXCEPTION_PTR_H -#pragma GCC visibility push(default) - #include <bits/c++config.h> #include <bits/exception_defines.h> #include <bits/cxxabi_init_exception.h> @@ -51,7 +49,7 @@ extern "C++" { -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { class type_info; @@ -283,6 +281,4 @@ namespace std } // extern "C++" -#pragma GCC visibility pop - #endif diff --git a/libstdc++-v3/libsupc++/initializer_list b/libstdc++-v3/libsupc++/initializer_list index 79d32b2..efa1f16 100644 --- a/libstdc++-v3/libsupc++/initializer_list +++ b/libstdc++-v3/libsupc++/initializer_list @@ -36,11 +36,9 @@ # include <bits/c++0x_warning.h> #else // C++0x -#pragma GCC visibility push(default) - #include <bits/c++config.h> -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { /// initializer_list template<class _E> @@ -102,8 +100,6 @@ namespace std { return __ils.end(); } } -#pragma GCC visibility pop - #endif // C++11 #endif // _INITIALIZER_LIST diff --git a/libstdc++-v3/libsupc++/nested_exception.h b/libstdc++-v3/libsupc++/nested_exception.h index 6f0d539..002a54e 100644 --- a/libstdc++-v3/libsupc++/nested_exception.h +++ b/libstdc++-v3/libsupc++/nested_exception.h @@ -30,18 +30,15 @@ #ifndef _GLIBCXX_NESTED_EXCEPTION_H #define _GLIBCXX_NESTED_EXCEPTION_H 1 -#pragma GCC visibility push(default) - #if __cplusplus < 201103L # include <bits/c++0x_warning.h> #else -#include <bits/c++config.h> #include <bits/move.h> extern "C++" { -namespace std +namespace std _GLIBCXX_VISIBILITY(default) { /** * @addtogroup exceptions @@ -165,7 +162,4 @@ namespace std } // extern "C++" #endif // C++11 - -#pragma GCC visibility pop - #endif // _GLIBCXX_NESTED_EXCEPTION_H diff --git a/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/equal.cc b/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/equal.cc index a343523..81534e9 100644 --- a/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/equal.cc +++ b/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/equal.cc @@ -34,8 +34,28 @@ test01() VERIFY( !(u == v) ); } +void +test02() +{ + std::normal_distribution<double> u(5.0, 2.0), v(u); + VERIFY( u == v ); + u.reset(); + VERIFY( u == v ); + + std::minstd_rand0 g1, g2; + (void) u(g1); // u._M_saved_available = true + VERIFY( !(u == v) ); + (void) v(g2); // v._M_saved_available = true + VERIFY( u == v ); + u.reset(); // u._M_saved_available = false + VERIFY( !(u == v) ); + v.reset(); // v._M_saved_available = false + VERIFY( u == v ); +} + int main() { test01(); + test02(); return 0; } diff --git a/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/serialize.cc b/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/serialize.cc index 9d8f827..d4f9f37 100644 --- a/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/serialize.cc +++ b/libstdc++-v3/testsuite/26_numerics/random/normal_distribution/operators/serialize.cc @@ -25,6 +25,7 @@ #include <random> #include <sstream> +#include <testsuite_hooks.h> void test01() @@ -37,10 +38,43 @@ test01() str << u; str >> v; + VERIFY( u == v ); +} + +void +test_pr105502() +{ + // PR libstdc++/105502 std::normal_distribution deserialization issue + std::stringstream str; + std::normal_distribution<> d{1, 2}, d2; + std::minstd_rand0 g; + str << d; + VERIFY( str ); + str >> d2; + VERIFY( str ); + VERIFY( d == d2 ); + + (void) d(g); // sets d._M_saved_available = true + str.str(""); + str.clear(); + str << d; + VERIFY( str ); + str >> d2; + VERIFY( str ); + VERIFY( d == d2 ); + + (void) d(g); // sets d._M_saved_available = false + str.str(""); + str.clear(); + str << d; + VERIFY( str ); + str >> d2; + VERIFY( str ); + VERIFY( d == d2 ); } int main() { test01(); - return 0; + test_pr105502(); } diff --git a/libstdc++-v3/testsuite/26_numerics/random/pr60037-neg.cc b/libstdc++-v3/testsuite/26_numerics/random/pr60037-neg.cc index 3ab9c44..c58f480 100644 --- a/libstdc++-v3/testsuite/26_numerics/random/pr60037-neg.cc +++ b/libstdc++-v3/testsuite/26_numerics/random/pr60037-neg.cc @@ -12,4 +12,4 @@ auto x = std::generate_canonical<std::size_t, // { dg-error "static assertion failed: template argument must be a floating point type" "" { target *-*-* } 169 } -// { dg-error "static assertion failed: template argument must be a floating point type" "" { target *-*-* } 3356 } +// { dg-error "static assertion failed: template argument must be a floating point type" "" { target *-*-* } 3348 } diff --git a/libstdc++-v3/testsuite/27_io/filesystem/iterators/error_reporting.cc b/libstdc++-v3/testsuite/27_io/filesystem/iterators/error_reporting.cc index 1f297a7..1c8ea4c 100644 --- a/libstdc++-v3/testsuite/27_io/filesystem/iterators/error_reporting.cc +++ b/libstdc++-v3/testsuite/27_io/filesystem/iterators/error_reporting.cc @@ -28,35 +28,44 @@ int choice; -struct dirent global_dirent; - extern "C" struct dirent* readdir(DIR*) { + // On some targets dirent::d_name is very small, but the OS allocates + // a trailing char array after the dirent struct. Emulate that here. + union State + { + struct dirent d; + char buf[sizeof(struct dirent) + 16] = {}; + }; + + static State state; + char* d_name = state.buf + offsetof(struct dirent, d_name); + switch (choice) { case 1: - global_dirent.d_ino = 999; + state.d.d_ino = 999; #if defined _GLIBCXX_HAVE_STRUCT_DIRENT_D_TYPE && defined DT_REG - global_dirent.d_type = DT_REG; + state.d.d_type = DT_REG; #endif - global_dirent.d_reclen = 0; - std::char_traits<char>::copy(global_dirent.d_name, "file", 5); + state.d.d_reclen = 0; + std::char_traits<char>::copy(d_name, "file", 5); choice = 0; - return &global_dirent; + return &state.d; case 2: - global_dirent.d_ino = 111; + state.d.d_ino = 111; #if defined _GLIBCXX_HAVE_STRUCT_DIRENT_D_TYPE && defined DT_DIR - global_dirent.d_type = DT_DIR; + state.d.d_type = DT_DIR; #endif - global_dirent.d_reclen = 60; - std::char_traits<char>::copy(global_dirent.d_name, "subdir", 7); + state.d.d_reclen = 60; + std::char_traits<char>::copy(d_name, "subdir", 7); choice = 1; - return &global_dirent; + return &state.d; default: errno = EIO; return nullptr; } - return &global_dirent; + return &state.d; } void |